From 4f099a038c1ce00ab8781789ec2d5b50d2b1ad84 Mon Sep 17 00:00:00 2001
From: tkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Wed, 27 May 2009 05:27:31 +0000
Subject: 2009-05-27 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/40187
* intrinsics/iso_c_binding.c (c_f_pointer_u0): Take care
of stride in "shape" argument.
2009-05-27 Thomas Koenig <tkoenig@gcc.gnu.org>
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