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  <jakub@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.

diff --git a/gcc/testsuite/gfortran.dg/pr120191_3.f90 b/gcc/testsuite/gfortran.dg/pr120191_3.f90
new file mode 100644 (file)
index 0000000..26e4095
--- /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 cbab817ca3b086f23bec0a0d3daffa04ba634db2..21ea81a1aac3b7308a2eda54538b1dd790d78a95 100644 (file)
--- 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 d7d8893f801ac2176917ce5f7600c1a21734f1a4..47e14c148bd438818bb7cf29786749c76e87daf2 100644 (file)
--- 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 51740eefe553539556d203dc4f37dc12f8301e83..66ee8d0f1dbc9e70c093110d30ebefa05a52b94e 100644 (file)
--- 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 cf04d6dbcaa4b4a48269c36380386e4a488d3a06..7d889c00596eb427f7b9ebe307823ee13060fe08 100644 (file)
--- 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 a35e55223be1a142b900851bdf05bde5dab16954..d4711e2e4742a9af938ec241ffce0d6c2957fa88 100644 (file)
--- 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 e264779dc541228a2783339d3e5e13dc08b92614..dea360e35adb574b70c101e4610e60613c7b89e2 100644 (file)
--- 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 82280092024a829793ac7cd59eed233dfefe3847..b654608a8d9430429bf8b3eddbbfea6fab1e59a1 100644 (file)
--- 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 e40bf54ceecd3e8fd15b86b7cc376efc90c27bb7..2e709a7c105dd0ad8d4d997c7dab971980dbc9b1 100644 (file)
--- 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 199d254d6e5f795f1ca1cc694c04ebacdae07014..61dad5530ee1fc365dc40c985e8c901954f2ac16 100644 (file)
--- 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 1f0174b0e5528adf6d56668c30fa5db96a882c76..49c25d06363bc7b8cd0e68a7ec703f1f7694bb2d 100644 (file)
--- 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 39bdb9b7c88cd7b47613f18b54264e407e4bf0ba..c0ac6e6ba7a4bb303ea786028434e9bc502785a1 100644 (file)
--- 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 ed74ac9c49d22bef8613cbcad0a83c9dbcaa0b4d..29624d0f41f0cb5d9dcd0295858ac9171b23f9a9 100644 (file)
--- 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 8275f6568c4ee78eb3b7b9a8dc4acf2c57511c6d..22182e9de279bc426cfcfecbe33579be7c66c826 100644 (file)
--- 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;