https://gcc.gnu.org/g:65a8260c19834511034fb62c73139aa304f7eac4
commit r15-9669-g65a8260c19834511034fb62c73139aa304f7eac4
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 6e860eeaa67d..d38d4229c489 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 e4ac04cc2583..09fdbf8ad12b 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 78a501230e08..0804f593ccb3 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 399dab76a9ec..6dac06e438c1 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 9e1d36f92742..5ced3c6a0872 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 a44c6f67308f..78ae1be37129 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 6381ad6a8218..9b4a92d81ebc 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 11011b78a7b0..eac46faeef2f 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 631484abfba4..bb22f6cad4c2 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 d6064371fca9..f3020d607674 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 b02200b3b3d7..04ec9134b2b6 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 9d33d134c121..fbb6d08aec4d 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 49ecae70d649..b6070b41d26f 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 8e7b4ab32f09..9524fc4c62a7 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;
}
