https://gcc.gnu.org/g:b3207c163f630752301a1c58b1a37c849e73dea4
commit r12-11186-gb3207c163f630752301a1c58b1a37c849e73dea4
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 d26268f1b2a3..a48d9ff6c068 100644
--- a/libgfortran/generated/maxloc1_16_s1.c
+++ b/libgfortran/generated/maxloc1_16_s1.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 15b1cfbaa4b2..696ffa0c5316 100644
--- a/libgfortran/generated/maxloc1_16_s4.c
+++ b/libgfortran/generated/maxloc1_16_s4.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 d34c3b809d19..ae56b3123a2a 100644
--- a/libgfortran/generated/maxloc1_4_s1.c
+++ b/libgfortran/generated/maxloc1_4_s1.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 eb7271b7ca8c..41863165f06f 100644
--- a/libgfortran/generated/maxloc1_4_s4.c
+++ b/libgfortran/generated/maxloc1_4_s4.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 0a4437f22db5..e8fce884f20d 100644
--- a/libgfortran/generated/maxloc1_8_s1.c
+++ b/libgfortran/generated/maxloc1_8_s1.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 58ebf4852392..d0edd294b0a5 100644
--- a/libgfortran/generated/maxloc1_8_s4.c
+++ b/libgfortran/generated/maxloc1_8_s4.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 ba4ee6e7eaeb..19206821b547 100644
--- a/libgfortran/generated/minloc1_16_s1.c
+++ b/libgfortran/generated/minloc1_16_s1.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 3776825789af..6c0eec1cee45 100644
--- a/libgfortran/generated/minloc1_16_s4.c
+++ b/libgfortran/generated/minloc1_16_s4.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 4e50252ab98b..6bd61270b7ac 100644
--- a/libgfortran/generated/minloc1_4_s1.c
+++ b/libgfortran/generated/minloc1_4_s1.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 6bb83e0a60c3..fda8ddd24ca6 100644
--- a/libgfortran/generated/minloc1_4_s4.c
+++ b/libgfortran/generated/minloc1_4_s4.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 933b5b36b4b4..084246b32c13 100644
--- a/libgfortran/generated/minloc1_8_s1.c
+++ b/libgfortran/generated/minloc1_8_s1.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 7337574ed62c..8efddfc1562b 100644
--- a/libgfortran/generated/minloc1_8_s4.c
+++ b/libgfortran/generated/minloc1_8_s4.c
@@ -468,7 +468,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;
@@ -476,8 +476,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 16615aa290fc..64c5c193df5d 100644
--- a/libgfortran/m4/ifunction-s.m4
+++ b/libgfortran/m4/ifunction-s.m4
@@ -432,7 +432,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;
@@ -440,8 +440,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;
