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 eddfe5f44cc7faed213ed975f8e2c0ea02c68755..ac780255ba7d8bda2ba7f4a635457cf61ae9cbae 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 7b1e9ae2da9ffdcb160442c4fa50dac65bd93a5a..a30e0747e85efe7d33849e5b32d745b2581b7e5a 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 90f3ae7e1e10a1fd54b4a8aed191047aa812c520..67922d229c16879235bbd499b01efd1d55cf9bb6 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 a63f979b82f2a20acb95090922e8ae2009708320..9121ae5ee6ef809ad15c1e7fc7931f597839f81a 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 0ecce57e0f4b5234c40e05d19f5c0b258a1d9dc4..60d886130d260e70f9cc2a0a90a1e72f54518885 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 be366845225dce314ea2292342cdfcd8b9e89e28..00818c229c15bea00a9663d9472a8442cb794118 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 f58b12c7cc5f6307ef7258abfebb4bbf73a8931c..3552f876f0c7fc810838431c047fdd7cfccafbe3 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 04a6a2b2dac0ee11057e70e2271ef0307a288c9b..2bf95fae4adc614de581cd9f0cdf7a68138ec2ca 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 5aa19954e269e716e2848d1f85bef48e93378d7d..e794116a6eae8cd8db9c3c205226437815a664cc 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 43185ff70bb24372754b8fbc458161e1f51ee8ed..7dcab779dd3ebce39ea58b15831fcece6b48e62b 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 df0a7818c297e19f72fdacce23bcf8dd4965ea66..cb19a17486b2470500b25eb1a2d8fab4a46b4354 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 70f5cf3d023871b9fe034e0a3850072ccfa67c25..ae66a69c1c36ac1958f62c9686b23878ec3c78ae 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;