https://gcc.gnu.org/g:87c7061cc0acc99c8f580d5e76eba288db341807
commit r14-11771-g87c7061cc0acc99c8f580d5e76eba288db341807
Author: Jakub Jelinek <ja...@redhat.com>
Date: Tue May 13 14:18:10 2025 +0200
libfortran: Fix up _gfortran_s{max,min}loc2_{4,8,16}_s{1,4} [PR120191]
I've tried to write a testcase for the BT_CHARACTER maxloc/minloc with named
or unnamed arguments and indeed the just posted patch fixed the arguments
in there in multiple cases to match what the library expects.
But the testcase still fails, due to library problems.
One dealt with in this patch are _gfortran_s{max,min}loc2_{4,8,16}_s{1,4}
functions. Those are trivial wrappers around
_gfortrani_{max,min}loc2_{4,8,16}_s{1,4} which should call those functions
if the scalar mask is true and just return 0 otherwise.
The two bugs I see there is that the back, len arguments are swapped,
which means that it always acts as back=.true. and for len will use
character length of 1 or 0 instead of the desired one.
The _gfortrani_{max,min}loc2_{4,8,16}_s{1,4} functions have prototypes like
GFC_INTEGER_4
maxloc2_4_s1 (gfc_array_s1 * const restrict array, GFC_LOGICAL_4 back,
gfc_charlen_type len)
so back comes before len, ditto for the
GFC_INTEGER_4
smaxloc2_4_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back, gfc_charlen_type
len)
The other problem is that it was just testing if (mask). In my limited
Fortran understanding that means that the optional argument mask was
supplied but nothing about its actual value. Other scalar mask generated
routines use if (mask == NULL || *mask) as the condition when to call the
non-masked function, i.e. when mask is not supplied (then it should act like
.true. mask) or when it is supplied and evaluates to .true.).
2025-05-13 Jakub Jelinek <ja...@redhat.com>
PR fortran/120191
* m4/maxloc2s.m4: For smaxloc2 call maxloc2 if mask is NULL or
*mask.
Swap back and len arguments.
* m4/minloc2s.m4: Likewise.
* generated/maxloc2_4_s1.c: Regenerate.
* generated/maxloc2_4_s4.c: Regenerate.
* generated/maxloc2_8_s1.c: Regenerate.
* generated/maxloc2_8_s4.c: Regenerate.
* generated/maxloc2_16_s1.c: Regenerate.
* generated/maxloc2_16_s4.c: Regenerate.
* generated/minloc2_4_s1.c: Regenerate.
* generated/minloc2_4_s4.c: Regenerate.
* generated/minloc2_8_s1.c: Regenerate.
* generated/minloc2_8_s4.c: Regenerate.
* generated/minloc2_16_s1.c: Regenerate.
* generated/minloc2_16_s4.c: Regenerate.
* gfortran.dg/pr120191_2.f90: New test.
(cherry picked from commit 482f2192d4ef6af55acae2dc3e0df00b8487cc7d)
Diff:
---
gcc/testsuite/gfortran.dg/pr120191_2.f90 | 84 ++++++++++++++++++++++++++++++++
libgfortran/generated/maxloc2_16_s1.c | 4 +-
libgfortran/generated/maxloc2_16_s4.c | 4 +-
libgfortran/generated/maxloc2_4_s1.c | 4 +-
libgfortran/generated/maxloc2_4_s4.c | 4 +-
libgfortran/generated/maxloc2_8_s1.c | 4 +-
libgfortran/generated/maxloc2_8_s4.c | 4 +-
libgfortran/generated/minloc2_16_s1.c | 4 +-
libgfortran/generated/minloc2_16_s4.c | 4 +-
libgfortran/generated/minloc2_4_s1.c | 4 +-
libgfortran/generated/minloc2_4_s4.c | 4 +-
libgfortran/generated/minloc2_8_s1.c | 4 +-
libgfortran/generated/minloc2_8_s4.c | 4 +-
libgfortran/m4/maxloc2s.m4 | 4 +-
libgfortran/m4/minloc2s.m4 | 4 +-
15 files changed, 112 insertions(+), 28 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/pr120191_2.f90
b/gcc/testsuite/gfortran.dg/pr120191_2.f90
new file mode 100644
index 000000000000..6334286861ba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120191_2.f90
@@ -0,0 +1,84 @@
+! PR fortran/120191
+! { dg-do run }
+
+ character(kind=1, len=2) :: a(4, 4, 4), b(4)
+ logical :: l(4, 4, 4), m, n(4)
+ a = 'aa'
+ b = 'aa'
+ l = .true.
+ m = .true.
+ n = .true.
+ if (any (maxloc (a) .ne. 1)) stop 1
+ if (any (maxloc (a, dim=1) .ne. 1)) stop 2
+ if (any (maxloc (a, 1) .ne. 1)) stop 3
+ if (any (maxloc (a, dim=1, mask=l, kind=4, back=.false.) .ne. 1)) stop 4
+ if (any (maxloc (a, 1, l, 4, .false.) .ne. 1)) stop 5
+ if (any (maxloc (a, dim=1, mask=m, kind=4, back=.false.) .ne. 1)) stop 6
+ if (any (maxloc (a, 1, m, 4, .false.) .ne. 1)) stop 7
+ if (any (maxloc (a, dim=1, mask=l, kind=4, back=.true.) .ne. 4)) stop 8
+ if (any (maxloc (a, 1, l, 4, .true.) .ne. 4)) stop 9
+ if (any (maxloc (a, dim=1, mask=m, kind=4, back=.true.) .ne. 4)) stop 10
+ if (any (maxloc (a, 1, m, 4, .true.) .ne. 4)) stop 11
+ if (any (maxloc (b) .ne. 1)) stop 12
+ if (maxloc (b, dim=1) .ne. 1) stop 13
+ if (maxloc (b, 1) .ne. 1) stop 14
+ if (maxloc (b, dim=1, mask=n, kind=4, back=.false.) .ne. 1) stop 15
+ if (maxloc (b, 1, n, 4, .false.) .ne. 1) stop 16
+ if (maxloc (b, dim=1, mask=m, kind=4, back=.false.) .ne. 1) stop 17
+ if (maxloc (b, 1, m, 4, .false.) .ne. 1) stop 18
+ if (maxloc (b, dim=1, mask=n, kind=4, back=.true.) .ne. 4) stop 19
+ if (maxloc (b, 1, n, 4, .true.) .ne. 4) stop 20
+ if (maxloc (b, dim=1, mask=m, kind=4, back=.true.) .ne. 4) stop 21
+ if (maxloc (b, 1, m, 4, .true.) .ne. 4) stop 22
+ l = .false.
+ m = .false.
+ n = .false.
+ if (any (maxloc (a, dim=1, mask=l, kind=4, back=.false.) .ne. 0)) stop 23
+ if (any (maxloc (a, 1, l, 4, .false.) .ne. 0)) stop 24
+ if (maxloc (b, dim=1, mask=n, kind=4, back=.false.) .ne. 0) stop 25
+ if (maxloc (b, 1, n, 4, .false.) .ne. 0) stop 26
+ if (maxloc (b, dim=1, mask=m, kind=4, back=.false.) .ne. 0) stop 27
+ if (maxloc (b, 1, m, 4, .false.) .ne. 0) stop 28
+ if (maxloc (b, dim=1, mask=n, kind=4, back=.true.) .ne. 0) stop 29
+ if (maxloc (b, 1, n, 4, .true.) .ne. 0) stop 30
+ if (maxloc (b, dim=1, mask=m, kind=4, back=.true.) .ne. 0) stop 31
+ if (maxloc (b, 1, m, 4, .true.) .ne. 0) stop 32
+ l = .true.
+ m = .true.
+ n = .true.
+ if (any (minloc (a) .ne. 1)) stop 1
+ if (any (minloc (a, dim=1) .ne. 1)) stop 2
+ if (any (minloc (a, 1) .ne. 1)) stop 3
+ if (any (minloc (a, dim=1, mask=l, kind=4, back=.false.) .ne. 1)) stop 4
+ if (any (minloc (a, 1, l, 4, .false.) .ne. 1)) stop 5
+ if (any (minloc (a, dim=1, mask=m, kind=4, back=.false.) .ne. 1)) stop 6
+ if (any (minloc (a, 1, m, 4, .false.) .ne. 1)) stop 7
+ if (any (minloc (a, dim=1, mask=l, kind=4, back=.true.) .ne. 4)) stop 8
+ if (any (minloc (a, 1, l, 4, .true.) .ne. 4)) stop 9
+ if (any (minloc (a, dim=1, mask=m, kind=4, back=.true.) .ne. 4)) stop 10
+ if (any (minloc (a, 1, m, 4, .true.) .ne. 4)) stop 11
+ if (any (minloc (b) .ne. 1)) stop 12
+ if (minloc (b, dim=1) .ne. 1) stop 13
+ if (minloc (b, 1) .ne. 1) stop 14
+ if (minloc (b, dim=1, mask=n, kind=4, back=.false.) .ne. 1) stop 15
+ if (minloc (b, 1, n, 4, .false.) .ne. 1) stop 16
+ if (minloc (b, dim=1, mask=m, kind=4, back=.false.) .ne. 1) stop 17
+ if (minloc (b, 1, m, 4, .false.) .ne. 1) stop 18
+ if (minloc (b, dim=1, mask=n, kind=4, back=.true.) .ne. 4) stop 19
+ if (minloc (b, 1, n, 4, .true.) .ne. 4) stop 20
+ if (minloc (b, dim=1, mask=m, kind=4, back=.true.) .ne. 4) stop 21
+ if (minloc (b, 1, m, 4, .true.) .ne. 4) stop 22
+ l = .false.
+ m = .false.
+ n = .false.
+ if (any (minloc (a, dim=1, mask=l, kind=4, back=.false.) .ne. 0)) stop 23
+ if (any (minloc (a, 1, l, 4, .false.) .ne. 0)) stop 24
+ if (minloc (b, dim=1, mask=n, kind=4, back=.false.) .ne. 0) stop 25
+ if (minloc (b, 1, n, 4, .false.) .ne. 0) stop 26
+ if (minloc (b, dim=1, mask=m, kind=4, back=.false.) .ne. 0) stop 27
+ if (minloc (b, 1, m, 4, .false.) .ne. 0) stop 28
+ if (minloc (b, dim=1, mask=n, kind=4, back=.true.) .ne. 0) stop 29
+ if (minloc (b, 1, n, 4, .true.) .ne. 0) stop 30
+ if (minloc (b, dim=1, mask=m, kind=4, back=.true.) .ne. 0) stop 31
+ if (minloc (b, 1, m, 4, .true.) .ne. 0) stop 32
+end
diff --git a/libgfortran/generated/maxloc2_16_s1.c
b/libgfortran/generated/maxloc2_16_s1.c
index 1b70989936e3..1d869813b0e5 100644
--- a/libgfortran/generated/maxloc2_16_s1.c
+++ b/libgfortran/generated/maxloc2_16_s1.c
@@ -152,8 +152,8 @@ GFC_INTEGER_16
smaxloc2_16_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return maxloc2_16_s1 (array, len, back);
+ if (mask == NULL || *mask)
+ return maxloc2_16_s1 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/maxloc2_16_s4.c
b/libgfortran/generated/maxloc2_16_s4.c
index 8b0a1e52b3c3..7e916d0cab30 100644
--- a/libgfortran/generated/maxloc2_16_s4.c
+++ b/libgfortran/generated/maxloc2_16_s4.c
@@ -152,8 +152,8 @@ GFC_INTEGER_16
smaxloc2_16_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return maxloc2_16_s4 (array, len, back);
+ if (mask == NULL || *mask)
+ return maxloc2_16_s4 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/maxloc2_4_s1.c
b/libgfortran/generated/maxloc2_4_s1.c
index fa7620c646ac..97ed40b1c496 100644
--- a/libgfortran/generated/maxloc2_4_s1.c
+++ b/libgfortran/generated/maxloc2_4_s1.c
@@ -152,8 +152,8 @@ GFC_INTEGER_4
smaxloc2_4_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return maxloc2_4_s1 (array, len, back);
+ if (mask == NULL || *mask)
+ return maxloc2_4_s1 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/maxloc2_4_s4.c
b/libgfortran/generated/maxloc2_4_s4.c
index e479f17a69d2..5bb89e1a723e 100644
--- a/libgfortran/generated/maxloc2_4_s4.c
+++ b/libgfortran/generated/maxloc2_4_s4.c
@@ -152,8 +152,8 @@ GFC_INTEGER_4
smaxloc2_4_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return maxloc2_4_s4 (array, len, back);
+ if (mask == NULL || *mask)
+ return maxloc2_4_s4 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/maxloc2_8_s1.c
b/libgfortran/generated/maxloc2_8_s1.c
index f43edbdd81b9..bd2947c4947e 100644
--- a/libgfortran/generated/maxloc2_8_s1.c
+++ b/libgfortran/generated/maxloc2_8_s1.c
@@ -152,8 +152,8 @@ GFC_INTEGER_8
smaxloc2_8_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return maxloc2_8_s1 (array, len, back);
+ if (mask == NULL || *mask)
+ return maxloc2_8_s1 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/maxloc2_8_s4.c
b/libgfortran/generated/maxloc2_8_s4.c
index 1a7c22521cc5..f84d98feab68 100644
--- a/libgfortran/generated/maxloc2_8_s4.c
+++ b/libgfortran/generated/maxloc2_8_s4.c
@@ -152,8 +152,8 @@ GFC_INTEGER_8
smaxloc2_8_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return maxloc2_8_s4 (array, len, back);
+ if (mask == NULL || *mask)
+ return maxloc2_8_s4 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/minloc2_16_s1.c
b/libgfortran/generated/minloc2_16_s1.c
index 4d92f9179435..fcdcce0b4f93 100644
--- a/libgfortran/generated/minloc2_16_s1.c
+++ b/libgfortran/generated/minloc2_16_s1.c
@@ -154,8 +154,8 @@ GFC_INTEGER_16
sminloc2_16_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return minloc2_16_s1 (array, len, back);
+ if (mask == NULL || *mask)
+ return minloc2_16_s1 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/minloc2_16_s4.c
b/libgfortran/generated/minloc2_16_s4.c
index b7175180ad47..8e35334e3da0 100644
--- a/libgfortran/generated/minloc2_16_s4.c
+++ b/libgfortran/generated/minloc2_16_s4.c
@@ -154,8 +154,8 @@ GFC_INTEGER_16
sminloc2_16_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return minloc2_16_s4 (array, len, back);
+ if (mask == NULL || *mask)
+ return minloc2_16_s4 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/minloc2_4_s1.c
b/libgfortran/generated/minloc2_4_s1.c
index 871c690e317a..07141c4cb68b 100644
--- a/libgfortran/generated/minloc2_4_s1.c
+++ b/libgfortran/generated/minloc2_4_s1.c
@@ -154,8 +154,8 @@ GFC_INTEGER_4
sminloc2_4_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return minloc2_4_s1 (array, len, back);
+ if (mask == NULL || *mask)
+ return minloc2_4_s1 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/minloc2_4_s4.c
b/libgfortran/generated/minloc2_4_s4.c
index d4748edd2ff5..4c580d5813a7 100644
--- a/libgfortran/generated/minloc2_4_s4.c
+++ b/libgfortran/generated/minloc2_4_s4.c
@@ -154,8 +154,8 @@ GFC_INTEGER_4
sminloc2_4_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return minloc2_4_s4 (array, len, back);
+ if (mask == NULL || *mask)
+ return minloc2_4_s4 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/minloc2_8_s1.c
b/libgfortran/generated/minloc2_8_s1.c
index 6c171753b8cd..f27b037d93aa 100644
--- a/libgfortran/generated/minloc2_8_s1.c
+++ b/libgfortran/generated/minloc2_8_s1.c
@@ -154,8 +154,8 @@ GFC_INTEGER_8
sminloc2_8_s1 (gfc_array_s1 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return minloc2_8_s1 (array, len, back);
+ if (mask == NULL || *mask)
+ return minloc2_8_s1 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/generated/minloc2_8_s4.c
b/libgfortran/generated/minloc2_8_s4.c
index fd3cc6ebaad1..0980f63478fa 100644
--- a/libgfortran/generated/minloc2_8_s4.c
+++ b/libgfortran/generated/minloc2_8_s4.c
@@ -154,8 +154,8 @@ GFC_INTEGER_8
sminloc2_8_s4 (gfc_array_s4 * const restrict array,
GFC_LOGICAL_4 *mask, GFC_LOGICAL_4 back,
gfc_charlen_type len)
{
- if (mask)
- return minloc2_8_s4 (array, len, back);
+ if (mask == NULL || *mask)
+ return minloc2_8_s4 (array, back, len);
else
return 0;
}
diff --git a/libgfortran/m4/maxloc2s.m4 b/libgfortran/m4/maxloc2s.m4
index 2a439dfee16a..6806f060e07b 100644
--- a/libgfortran/m4/maxloc2s.m4
+++ b/libgfortran/m4/maxloc2s.m4
@@ -153,8 +153,8 @@ export_proto(s'name`'rtype_qual`_'atype_code`);
s'name`'rtype_qual`_'atype_code` ('atype` * const restrict array,
GFC_LOGICAL_4 *mask'back_arg`,
gfc_charlen_type len)
{
- if (mask)
- return 'name`'rtype_qual`_'atype_code` (array, len, back);
+ if (mask == NULL || *mask)
+ return 'name`'rtype_qual`_'atype_code` (array, back, len);
else
return 0;
}
diff --git a/libgfortran/m4/minloc2s.m4 b/libgfortran/m4/minloc2s.m4
index 068a58af259e..7a300e0b98f2 100644
--- a/libgfortran/m4/minloc2s.m4
+++ b/libgfortran/m4/minloc2s.m4
@@ -155,8 +155,8 @@ export_proto(s'name`'rtype_qual`_'atype_code`);
s'name`'rtype_qual`_'atype_code` ('atype` * const restrict array,
GFC_LOGICAL_4 *mask'back_arg`,
gfc_charlen_type len)
{
- if (mask)
- return 'name`'rtype_qual`_'atype_code` (array, len, back);
+ if (mask == NULL || *mask)
+ return 'name`'rtype_qual`_'atype_code` (array, back, len);
else
return 0;
}
