From: Jakub Jelinek <jakub@redhat.com>
Date: Tue, 13 May 2025 12:19:25 +0000 (+0200)
Subject: libfortran: Fix up _gfortran_s{max,min}loc1_{4,8,16}_s{1,4} [PR120191]
X-Git-Tag: releases/gcc-12.5.0~75
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b3207c163f630752301a1c58b1a37c849e73dea4;p=thirdparty%2Fgcc.git

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
index 00000000000..26e4095d9b1
--- /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 d26268f1b2a..a48d9ff6c06 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 15b1cfbaa4b..696ffa0c531 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 d34c3b809d1..ae56b3123a2 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 eb7271b7ca8..41863165f06 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 0a4437f22db..e8fce884f20 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 58ebf485239..d0edd294b0a 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 ba4ee6e7eae..19206821b54 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 3776825789a..6c0eec1cee4 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 4e50252ab98..6bd61270b7a 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 6bb83e0a60c..fda8ddd24ca 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 933b5b36b4b..084246b32c1 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 7337574ed62..8efddfc1562 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 16615aa290f..64c5c193df5 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;