https://gcc.gnu.org/g:a79e30dabb6b3edc29f2656b7d480076a1f4d3bd
commit r14-11772-ga79e30dabb6b3edc29f2656b7d480076a1f4d3bd
Author: Jakub Jelinek <ja...@redhat.com>
Date: Tue May 13 14:19:25 2025 +0200
libfortran: Fix up _gfortran_s{max,min}loc1_{4,8,16}_s{1,4} [PR120191]
There is a bug in _gfortran_s{max,min}loc1_{4,8,16}_s{1,4} which the
following testcase shows.
The functions return but then crash in the caller.
Seems that is because buffer overflows, I believe those functions for
if (mask == NULL || *mask) condition being false are supposed to fill in
the result array with all zeros (or allocate it and fill it with zeros).
My understanding is the result array in that case is integer(kind={4,8,16})
and should have the extents the character input array has.
The problem is that it uses * string_len in the extent multiplication:
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
and
extent[n] =
GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
which is I guess fine and desirable for the extents of the character array,
but not for the extents of the destination array. Yet the code uses
that extent array for that purpose (and no other purposes).
Here it uses it to set the dimensions for the case where it needs to
allocate (as well as size):
for (n = 0; n < rank; n++)
{
if (n == 0)
str = 1;
else
str = GFC_DESCRIPTOR_STRIDE(retarray,n-1) * extent[n-1];
GFC_DIMENSION_SET(retarray->dim[n], 0, extent[n] - 1, str);
}
Here it uses it for bounds checking of the destination:
if (unlikely (compile_options.bounds_check))
{
for (n=0; n < rank; n++)
{
index_type ret_extent;
ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
if (extent[n] != ret_extent)
runtime_error ("Incorrect extent in return value of"
" MAXLOC intrinsic in dimension %ld:"
" is %ld, should be %ld", (long int) n + 1,
(long int) ret_extent, (long int) extent[n]);
}
}
and here to find out how many retarray elements to actually fill in each
dimension:
while(1)
{
*dest = 0;
count[0]++;
dest += dstride[0];
n = 0;
while (count[n] == extent[n])
{
/* When we get to the end of a dimension, reset it and increment
the next dimension. */
count[n] = 0;
/* We could precalculate these products, but this is a less
frequently used path so probably not worth it. */
dest -= dstride[n] * extent[n];
Seems maxloc1s.m4 and minloc1s.m4 are the only users of ifunction-s.m4,
so we can change SCALAR_ARRAY_FUNCTION in there without breaking anything
else.
2025-05-13 Jakub Jelinek <ja...@redhat.com>
PR fortran/120191
* m4/ifunction-s.m4 (SCALAR_ARRAY_FUNCTION): Don't multiply
GFC_DESCRIPTOR_EXTENT(array,) by string_len.
* generated/maxloc1_4_s1.c: Regenerate.
* generated/maxloc1_4_s4.c: Regenerate.
* generated/maxloc1_8_s1.c: Regenerate.
* generated/maxloc1_8_s4.c: Regenerate.
* generated/maxloc1_16_s1.c: Regenerate.
* generated/maxloc1_16_s4.c: Regenerate.
* generated/minloc1_4_s1.c: Regenerate.
* generated/minloc1_4_s4.c: Regenerate.
* generated/minloc1_8_s1.c: Regenerate.
* generated/minloc1_8_s4.c: Regenerate.
* generated/minloc1_16_s1.c: Regenerate.
* generated/minloc1_16_s4.c: Regenerate.
* gfortran.dg/pr120191_3.f90: New test.
(cherry picked from commit 781cfc454b8dc24952fe7f4c5c409296dca505e1)
Diff:
---
gcc/testsuite/gfortran.dg/pr120191_3.f90 | 23 +++++++++++++++++++++++
libgfortran/generated/maxloc1_16_s1.c | 5 ++---
libgfortran/generated/maxloc1_16_s4.c | 5 ++---
libgfortran/generated/maxloc1_4_s1.c | 5 ++---
libgfortran/generated/maxloc1_4_s4.c | 5 ++---
libgfortran/generated/maxloc1_8_s1.c | 5 ++---
libgfortran/generated/maxloc1_8_s4.c | 5 ++---
libgfortran/generated/minloc1_16_s1.c | 5 ++---
libgfortran/generated/minloc1_16_s4.c | 5 ++---
libgfortran/generated/minloc1_4_s1.c | 5 ++---
libgfortran/generated/minloc1_4_s4.c | 5 ++---
libgfortran/generated/minloc1_8_s1.c | 5 ++---
libgfortran/generated/minloc1_8_s4.c | 5 ++---
libgfortran/m4/ifunction-s.m4 | 5 ++---
14 files changed, 49 insertions(+), 39 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/pr120191_3.f90
b/gcc/testsuite/gfortran.dg/pr120191_3.f90
new file mode 100644
index 000000000000..26e4095d9b1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120191_3.f90
@@ -0,0 +1,23 @@
+! 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 = .false.
+ m = .false.
+ n = .false.
+ if (any (maxloc (a, dim=1, mask=m, kind=4, back=.false.) .ne. 0)) stop 1
+ if (any (maxloc (a, 1, m, 4, .false.) .ne. 0)) stop 2
+ if (any (maxloc (a, dim=1, mask=l, kind=4, back=.true.) .ne. 0)) stop 3
+ if (any (maxloc (a, 1, l, 4, .true.) .ne. 0)) stop 4
+ if (any (maxloc (a, dim=1, mask=m, kind=4, back=.true.) .ne. 0)) stop 5
+ if (any (maxloc (a, 1, m, 4, .true.) .ne. 0)) stop 6
+ if (any (minloc (a, dim=1, mask=m, kind=4, back=.false.) .ne. 0)) stop 7
+ if (any (minloc (a, 1, m, 4, .false.) .ne. 0)) stop 8
+ if (any (minloc (a, dim=1, mask=l, kind=4, back=.true.) .ne. 0)) stop 9
+ if (any (minloc (a, 1, l, 4, .true.) .ne. 0)) stop 10
+ if (any (minloc (a, dim=1, mask=m, kind=4, back=.true.) .ne. 0)) stop 11
+ if (any (minloc (a, 1, m, 4, .true.) .ne. 0)) stop 12
+end
diff --git a/libgfortran/generated/maxloc1_16_s1.c
b/libgfortran/generated/maxloc1_16_s1.c
index eddfe5f44cc7..ac780255ba7d 100644
--- a/libgfortran/generated/maxloc1_16_s1.c
+++ b/libgfortran/generated/maxloc1_16_s1.c
@@ -457,7 +457,7 @@ smaxloc1_16_s1 (gfc_array_i16 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ smaxloc1_16_s1 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/maxloc1_16_s4.c
b/libgfortran/generated/maxloc1_16_s4.c
index 7b1e9ae2da9f..a30e0747e85e 100644
--- a/libgfortran/generated/maxloc1_16_s4.c
+++ b/libgfortran/generated/maxloc1_16_s4.c
@@ -457,7 +457,7 @@ smaxloc1_16_s4 (gfc_array_i16 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ smaxloc1_16_s4 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/maxloc1_4_s1.c
b/libgfortran/generated/maxloc1_4_s1.c
index 90f3ae7e1e10..67922d229c16 100644
--- a/libgfortran/generated/maxloc1_4_s1.c
+++ b/libgfortran/generated/maxloc1_4_s1.c
@@ -457,7 +457,7 @@ smaxloc1_4_s1 (gfc_array_i4 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ smaxloc1_4_s1 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/maxloc1_4_s4.c
b/libgfortran/generated/maxloc1_4_s4.c
index a63f979b82f2..9121ae5ee6ef 100644
--- a/libgfortran/generated/maxloc1_4_s4.c
+++ b/libgfortran/generated/maxloc1_4_s4.c
@@ -457,7 +457,7 @@ smaxloc1_4_s4 (gfc_array_i4 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ smaxloc1_4_s4 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/maxloc1_8_s1.c
b/libgfortran/generated/maxloc1_8_s1.c
index 0ecce57e0f4b..60d886130d26 100644
--- a/libgfortran/generated/maxloc1_8_s1.c
+++ b/libgfortran/generated/maxloc1_8_s1.c
@@ -457,7 +457,7 @@ smaxloc1_8_s1 (gfc_array_i8 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ smaxloc1_8_s1 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/maxloc1_8_s4.c
b/libgfortran/generated/maxloc1_8_s4.c
index be366845225d..00818c229c15 100644
--- a/libgfortran/generated/maxloc1_8_s4.c
+++ b/libgfortran/generated/maxloc1_8_s4.c
@@ -457,7 +457,7 @@ smaxloc1_8_s4 (gfc_array_i8 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ smaxloc1_8_s4 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/minloc1_16_s1.c
b/libgfortran/generated/minloc1_16_s1.c
index f58b12c7cc5f..3552f876f0c7 100644
--- a/libgfortran/generated/minloc1_16_s1.c
+++ b/libgfortran/generated/minloc1_16_s1.c
@@ -457,7 +457,7 @@ sminloc1_16_s1 (gfc_array_i16 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ sminloc1_16_s1 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/minloc1_16_s4.c
b/libgfortran/generated/minloc1_16_s4.c
index 04a6a2b2dac0..2bf95fae4adc 100644
--- a/libgfortran/generated/minloc1_16_s4.c
+++ b/libgfortran/generated/minloc1_16_s4.c
@@ -457,7 +457,7 @@ sminloc1_16_s4 (gfc_array_i16 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ sminloc1_16_s4 (gfc_array_i16 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/minloc1_4_s1.c
b/libgfortran/generated/minloc1_4_s1.c
index 5aa19954e269..e794116a6eae 100644
--- a/libgfortran/generated/minloc1_4_s1.c
+++ b/libgfortran/generated/minloc1_4_s1.c
@@ -457,7 +457,7 @@ sminloc1_4_s1 (gfc_array_i4 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ sminloc1_4_s1 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/minloc1_4_s4.c
b/libgfortran/generated/minloc1_4_s4.c
index 43185ff70bb2..7dcab779dd3e 100644
--- a/libgfortran/generated/minloc1_4_s4.c
+++ b/libgfortran/generated/minloc1_4_s4.c
@@ -457,7 +457,7 @@ sminloc1_4_s4 (gfc_array_i4 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ sminloc1_4_s4 (gfc_array_i4 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/minloc1_8_s1.c
b/libgfortran/generated/minloc1_8_s1.c
index df0a7818c297..cb19a17486b2 100644
--- a/libgfortran/generated/minloc1_8_s1.c
+++ b/libgfortran/generated/minloc1_8_s1.c
@@ -457,7 +457,7 @@ sminloc1_8_s1 (gfc_array_i8 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ sminloc1_8_s1 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/generated/minloc1_8_s4.c
b/libgfortran/generated/minloc1_8_s4.c
index 70f5cf3d0238..ae66a69c1c36 100644
--- a/libgfortran/generated/minloc1_8_s4.c
+++ b/libgfortran/generated/minloc1_8_s4.c
@@ -457,7 +457,7 @@ sminloc1_8_s4 (gfc_array_i8 * const restrict retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -465,8 +465,7 @@ sminloc1_8_s4 (gfc_array_i8 * const restrict retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
diff --git a/libgfortran/m4/ifunction-s.m4 b/libgfortran/m4/ifunction-s.m4
index 8275f6568c4e..22182e9de279 100644
--- a/libgfortran/m4/ifunction-s.m4
+++ b/libgfortran/m4/ifunction-s.m4
@@ -421,7 +421,7 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
for (n = 0; n < dim; n++)
{
- extent[n] = GFC_DESCRIPTOR_EXTENT(array,n) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
if (extent[n] <= 0)
extent[n] = 0;
@@ -429,8 +429,7 @@ s'name`'rtype_qual`_'atype_code` ('rtype` * const restrict
retarray,
for (n = dim; n < rank; n++)
{
- extent[n] =
- GFC_DESCRIPTOR_EXTENT(array,n + 1) * string_len;
+ extent[n] = GFC_DESCRIPTOR_EXTENT(array,n + 1);
if (extent[n] <= 0)
extent[n] = 0;
