I ran into this bug in CFI_allocate while testing something else and then realized there was already a PR open for it. It seems like an easy fix, and I've used Tobias's test case from the issue more or less verbatim.

There were some other bugs added on to this issue but I think they have all been fixed already except for this one.

OK to check in?

-Sandra
commit de9920753469e36c968b273a0e8b4d66a1d57946
Author: Sandra Loosemore <san...@codesourcery.com>
Date:   Sun Jun 20 22:37:55 2021 -0700

    Fortran: fix sm computation in CFI_allocate [PR93524]
    
    This patch fixes a bug in setting the step multiplier field in the
    C descriptor for array dimensions > 2.
    
    2021-06-20  Sandra Loosemore  <san...@codesourcery.com>
                Tobias Burnus  <tob...@codesourcery.com>
    
    libgfortran/
    	PR fortran/93524
    	* runtime/ISO_Fortran_binding.c (CFI_allocate): Fix
    	sm computation.
    
    gcc/testsuite/
    	PR fortran/93524
    	* gfortran.dg/pr93524.c, gfortran.dg/pr93524.f90: New.

diff --git a/gcc/testsuite/gfortran.dg/pr93524.c b/gcc/testsuite/gfortran.dg/pr93524.c
new file mode 100644
index 0000000..8a6c066
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93524.c
@@ -0,0 +1,33 @@
+/* Test the fix for PR93524, in which CFI_allocate was computing
+   sm incorrectly for dimensions > 2.  */
+
+#include <stdlib.h>  // For size_t
+#include <ISO_Fortran_binding.h>
+
+void my_fortran_sub_1 (CFI_cdesc_t *dv); 
+void my_fortran_sub_2 (CFI_cdesc_t *dv); 
+
+int main ()
+{
+  CFI_CDESC_T (3) a;
+  CFI_cdesc_t *dv = (CFI_cdesc_t *) &a;
+  // dv, base_addr, attribute,            type, elem_len, rank, extents
+  CFI_establish (dv, NULL, CFI_attribute_allocatable, CFI_type_float, 0, 3, NULL); 
+
+  if (dv->base_addr != NULL)
+    return 1;  // shall not be allocated
+
+  CFI_index_t lower_bounds[] = {-10, 0, 3}; 
+  CFI_index_t upper_bounds[] = {10, 5, 10}; 
+  size_t elem_len = 0;  // only needed for strings
+  if (CFI_SUCCESS != CFI_allocate (dv, lower_bounds, upper_bounds, elem_len))
+    return 2;
+
+  if (!CFI_is_contiguous (dv))
+    return 2;  // allocatables shall be contiguous,unless a strided section is used
+
+  my_fortran_sub_1 (dv);
+  my_fortran_sub_2 (dv);
+  CFI_deallocate (dv);
+  return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/pr93524.f90 b/gcc/testsuite/gfortran.dg/pr93524.f90
new file mode 100644
index 0000000..b21030b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr93524.f90
@@ -0,0 +1,15 @@
+! { dg-additional-sources pr93524.c }
+! { dg-do run }
+!
+! Test the fix for PR93524.  The main program is in pr93524.c.
+
+subroutine my_fortran_sub_1 (A) bind(C)
+  real :: A(:, :, :)
+  print *, 'Lower bounds: ', lbound(A) ! Lower bounds:    1    1    1
+  print *, 'Upper bounds: ', ubound(A) ! Upper bounds:   21    6    8
+end
+subroutine my_fortran_sub_2 (A) bind(C)
+  real, ALLOCATABLE :: A(:, :, :)
+  print *, 'Lower bounds: ', lbound(A)
+  print *, 'Upper bounds: ', ubound(A)
+end subroutine my_fortran_sub_2
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index 20833ad..0978832 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -254,10 +254,7 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
 	{
 	  dv->dim[i].lower_bound = lower_bounds[i];
 	  dv->dim[i].extent = upper_bounds[i] - dv->dim[i].lower_bound + 1;
-	  if (i == 0)
-	    dv->dim[i].sm = dv->elem_len;
-	  else
-	    dv->dim[i].sm = dv->elem_len * dv->dim[i - 1].extent;
+	  dv->dim[i].sm = dv->elem_len * arr_len;
 	  arr_len *= dv->dim[i].extent;
         }
     }

Reply via email to