Fix strides for C descriptors with stride > 2.
authorHarris Snyder <hsnyder@structura.bio>
Wed, 27 Jan 2021 21:54:04 +0000 (22:54 +0100)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Wed, 27 Jan 2021 21:57:41 +0000 (22:57 +0100)
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.

gcc/testsuite/gfortran.dg/ISO_Fortran_binding_18.c [new file with mode: 0644]
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_18.f90 [new file with mode: 0644]
libgfortran/runtime/ISO_Fortran_binding.c

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 (file)
index 0000000..4d1c4ec
--- /dev/null
@@ -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 (file)
index 0000000..76be51d
--- /dev/null
@@ -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
index 3746ec1c681eeb957783f196297a2649eea40d10..20833ad20252e8f031519e5eea67ffbd512b6064 100644 (file)
@@ -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);
+           }
        }
     }