From 1cdca4261e88f4dc9c3293c6b3c2fff3071ca32b Mon Sep 17 00:00:00 2001
From: Harris Snyder <hsnyder@structura.bio>
Date: Wed, 27 Jan 2021 22:54:04 +0100
Subject: [PATCH] Fix strides for C descriptors with stride > 2.

libgfortran/ChangeLog:

	* runtime/ISO_Fortran_binding.c (CFI_establish): fixed
	strides for rank >2 arrays.

gcc/testsuite/ChangeLog:

	* gfortran.dg/ISO_Fortran_binding_18.c: New test.
	* gfortran.dg/ISO_Fortran_binding_18.f90: New test.
---
 .../gfortran.dg/ISO_Fortran_binding_18.c      | 29 +++++++++++++++++++
 .../gfortran.dg/ISO_Fortran_binding_18.f90    | 28 ++++++++++++++++++
 libgfortran/runtime/ISO_Fortran_binding.c     |  7 ++++-
 3 files changed, 63 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/ISO_Fortran_binding_18.c
 create mode 100644 gcc/testsuite/gfortran.dg/ISO_Fortran_binding_18.f90

diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_18.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_18.c
new file mode 100644
index 00000000000..4d1c4ecbd72
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_18.c
@@ -0,0 +1,29 @@
+#include <ISO_Fortran_binding.h>
+
+#include <stdlib.h>
+#include <string.h>
+
+
+
+extern int do_loop(CFI_cdesc_t* array);
+
+int main(int argc, char ** argv)
+{
+	int nx = 9;
+	int ny = 10;
+	int nz = 2;
+
+	int arr[nx*ny*nz];
+	memset(arr,0,sizeof(int)*nx*ny*nz);
+	CFI_index_t shape[3];
+	shape[0] = nz;
+	shape[1] = ny;
+	shape[2] = nx;
+
+	CFI_CDESC_T(3) farr;
+	int rc = CFI_establish((CFI_cdesc_t*)&farr, arr, CFI_attribute_other, CFI_type_int, 0, (CFI_rank_t)3, (const CFI_index_t *)shape);
+	if (rc != CFI_SUCCESS) abort();
+	int result = do_loop((CFI_cdesc_t*)&farr);
+	if (result != nx*ny*nz) abort();
+	return 0;
+}
diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_18.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_18.f90
new file mode 100644
index 00000000000..76be51d22fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_18.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-additional-sources ISO_Fortran_binding_18.c }
+
+module fortran_binding_test_18
+    use iso_c_binding
+    implicit none
+contains
+
+    subroutine test(array)
+        integer(c_int) :: array(:)
+        array = 1
+    end subroutine
+
+    function do_loop(array) result(the_sum) bind(c)
+        integer(c_int), intent(in out) :: array(:,:,:)
+        integer(c_int) :: the_sum, i, j
+
+        the_sum = 0  
+        array = 0
+        do i=1,size(array,3)
+            do j=1,size(array,2)
+                call test(array(:,j,i))
+            end do
+        end do
+        the_sum = sum(array)
+    end function
+
+end module
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index 3746ec1c681..20833ad2025 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -391,7 +391,12 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
 	  if (i == 0)
 	    dv->dim[i].sm = dv->elem_len;
 	  else
-	    dv->dim[i].sm = (CFI_index_t)(dv->elem_len * extents[i - 1]);
+	    {
+	      CFI_index_t extents_product = 1;
+	      for (int j = 0; j < i; j++)
+		extents_product *= extents[j];
+	      dv->dim[i].sm = (CFI_index_t)(dv->elem_len * extents_product);
+	    }
 	}
     }
 
-- 
2.30.2