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.
This commit is contained in:
Harris Snyder 2021-01-27 22:54:04 +01:00 committed by Thomas Koenig
parent 081c96621d
commit 1cdca4261e
3 changed files with 63 additions and 1 deletions

View file

@ -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;
}

View file

@ -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

View 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);
}
}
}