(re-sending with subject line tags)
Hi all,
Now that my copyright assignment is complete, I'm submitting this fix.
Test cases are included.
OK for master? I do not have write access, so someone will need to
commit this for me.
Regards,
Harris
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.
> On Wed, Jan 13, 2021 at 2:10 PM Harris Snyder <hsny...@structura.bio> wrote:
> >
> > Hi Tobias / all,
> >
> > Further related to https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93524
> > `sm` is being incorrectly computed in CFI_establish. Take a look at
> > the diff below - we are currently only using the extent of the
> > previous rank to assign `sm`, instead of all previous ranks. Have I
> > got this right, or am I missing something / does this need to be
> > handled differently? I can offer some test cases and submit a proper
> > patch if we think this solution is OK...
> >
> > Thanks,
> > Harris
> >
> > 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);
> > + }
> > }
> > }
commit 451bd40aca006ebdba52553de2392fcb5b1ff42f
Author: Harris M. Snyder <harris.sny...@gmail.com>
Date: Tue Jan 26 23:29:24 2021 -0500
Partial fix for PR fortran/93524
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);
+ }
}
}
