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.

(cherry picked from commit 781cfc454b8dc24952fe7f4c5c409296dca505e1)

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 313ee1cf440d179c8a4c62b3c5aff61ee985d0a7..6c5ff910760fe62decb260a714bca40471057359 100644 (file)
--- 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 d8da8569e15a3fe51543f9d620d90535bfb4af79..7e02ed1388c3a28a3b549de8eaa59fc2d6d34e21 100644 (file)
--- 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 904c5d4a8fa94b74f5f3b5ae434ac33d36cf7271..acfb4d796e889e468c28df6422207cdb558cafb9 100644 (file)
--- 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 5b1f7b0938d1fa6c210da056cc6cea3f8f7b6a3d..38801333301c7a5df7ca0a60d8b91c6b355db905 100644 (file)
--- 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 9659f7f74a6a053cf869e01ca1cefac03ad21a33..95d61b2b115bda603b6024215d2bf1653eeff9b0 100644 (file)
--- 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 10302b95adeecc99435b54dde0bd8e2ceca17181..775a142c1b1885d319907d45bb5b494cb485c5d4 100644 (file)
--- 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 3419055dc70acbce42b7949924e27c2c76dec9c9..1ec101662444c337ff5c694daa5abe31fef3f999 100644 (file)
--- 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 aad2f87386fba3c28fab7754f50a7716ecc253cb..47b6b3e9c1539c87ee6659307e8b674cbfc0db9b 100644 (file)
--- 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 da8e49a8029c1672bb0eb818c66fbb51f0367495..b06fc46e7db9a30d611d81814432232d0054d135 100644 (file)
--- 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 ca708992edea6615bf68ae8895c2bdc2f1cf65b3..4da6d93f0fe50205e60e222cfb5d823db6ad8ba3 100644 (file)
--- 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 6e26878fc02125acc34c8068d85a1873e1c604a8..e0f6c749fc51ae8d62e16875b7db26b46f4b89ac 100644 (file)
--- 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 14e5c9e7395a3d83546f04f004ba9a0d743dc415..895af54ea6bf8757fe965e9c6052932ff31da634 100644 (file)
--- 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 16615aa290fc93031e2bb783e22b5a510f99dca6..64c5c193df5d28f62b771334a063f05756157c52 100644 (file)
--- 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;