From 4f099a038c1ce00ab8781789ec2d5b50d2b1ad84 Mon Sep 17 00:00:00 2001 From: tkoenig Date: Wed, 27 May 2009 05:27:31 +0000 Subject: 2009-05-27 Thomas Koenig PR libfortran/40187 * intrinsics/iso_c_binding.c (c_f_pointer_u0): Take care of stride in "shape" argument. 2009-05-27 Thomas Koenig PR libfortran/40187 * gfortran.dg/c_f_pointer_shape_tests_4.f03: New file. * gfortran.dg/c_f_pointer_shape_tests_4_driver.c: New file. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@147894 138bc75d-0d04-0410-961f-82ee72b054a4 --- libgfortran/intrinsics/iso_c_binding.c | 62 +++++++++++++++++++--------------- 1 file changed, 35 insertions(+), 27 deletions(-) (limited to 'libgfortran/intrinsics') diff --git a/libgfortran/intrinsics/iso_c_binding.c b/libgfortran/intrinsics/iso_c_binding.c index a8d876832cb..38f07753c72 100644 --- a/libgfortran/intrinsics/iso_c_binding.c +++ b/libgfortran/intrinsics/iso_c_binding.c @@ -95,9 +95,17 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in, if (shape != NULL) { + index_type source_stride; + index_type size; + char *p; + f_ptr_out->offset = 0; shapeSize = 0; - + p = shape->data; + size = GFC_DESCRIPTOR_SIZE(shape); + + source_stride = shape->dim[0].stride * size; + /* shape's length (rank of the output array) */ shapeSize = shape->dim[0].ubound + 1 - shape->dim[0].lbound; for (i = 0; i < shapeSize; i++) @@ -107,40 +115,40 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (void *c_ptr_in, /* Have to allow for the SHAPE array to be any valid kind for an INTEGER type. */ #ifdef HAVE_GFC_INTEGER_1 - if (GFC_DESCRIPTOR_SIZE (shape) == 1) - f_ptr_out->dim[i].ubound = ((GFC_INTEGER_1 *) (shape->data))[i]; + if (size == 1) + f_ptr_out->dim[i].ubound = *((GFC_INTEGER_1 *) p); #endif #ifdef HAVE_GFC_INTEGER_2 - if (GFC_DESCRIPTOR_SIZE (shape) == 2) - f_ptr_out->dim[i].ubound = ((GFC_INTEGER_2 *) (shape->data))[i]; + if (size == 2) + f_ptr_out->dim[i].ubound = *((GFC_INTEGER_2 *) p); #endif #ifdef HAVE_GFC_INTEGER_4 - if (GFC_DESCRIPTOR_SIZE (shape) == 4) - f_ptr_out->dim[i].ubound = ((GFC_INTEGER_4 *) (shape->data))[i]; + if (size == 4) + f_ptr_out->dim[i].ubound = *((GFC_INTEGER_4 *) p); #endif #ifdef HAVE_GFC_INTEGER_8 - if (GFC_DESCRIPTOR_SIZE (shape) == 8) - f_ptr_out->dim[i].ubound = ((GFC_INTEGER_8 *) (shape->data))[i]; + if (size == 8) + f_ptr_out->dim[i].ubound = *((GFC_INTEGER_8 *) p); #endif #ifdef HAVE_GFC_INTEGER_16 - if (GFC_DESCRIPTOR_SIZE (shape) == 16) - f_ptr_out->dim[i].ubound = ((GFC_INTEGER_16 *) (shape->data))[i]; -#endif - } - - /* Set the offset and strides. - offset is (sum of (dim[i].lbound * dim[i].stride) for all - dims) the -1 means we'll back the data pointer up that much - perhaps we could just realign the data pointer and not change - the offset? */ - f_ptr_out->dim[0].stride = 1; - f_ptr_out->offset = f_ptr_out->dim[0].lbound * f_ptr_out->dim[0].stride; - for (i = 1; i < shapeSize; i++) - { - f_ptr_out->dim[i].stride = (f_ptr_out->dim[i-1].ubound + 1) - - f_ptr_out->dim[i-1].lbound; - f_ptr_out->offset += f_ptr_out->dim[i].lbound - * f_ptr_out->dim[i].stride; + if (size == 16) + f_ptr_out->dim[i].ubound = *((GFC_INTEGER_16 *) p); +#endif + p += source_stride; + + if (i == 0) + { + f_ptr_out->dim[0].stride = 1; + f_ptr_out->offset = f_ptr_out->dim[0].lbound + * f_ptr_out->dim[0].stride; + } + else + { + f_ptr_out->dim[i].stride = (f_ptr_out->dim[i-1].ubound + 1) + - f_ptr_out->dim[i-1].lbound; + f_ptr_out->offset += f_ptr_out->dim[i].lbound + * f_ptr_out->dim[i].stride; + } } f_ptr_out->offset *= -1; -- cgit v1.2.1