[patch, fortran-dev] Finalize array access macros, fix PR 40187

[Thomas Koenig <tkoenig at netcologne dot de>]

Hello world,

this is the final array access macro patch.  It also implements the fix
for PR 40187, which is already on trunk, in a slightly different way in
order to accomodate these macros.

In "poisoning" the struct descripto_dimenson by changing the names of
its members, I found I'd over looked a few cases (as was to be
expected :-)

Test cases are identical to trunk, not re-attached.  Regression-tested
on i686-pc-linux-gnu.  OK for the branch?

	Thomas

2009-05-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/37577
	PR libfortran/40187
	* runtime/in_pack_generic (internal_pack):  Remove unnecessary
	test for stride == 0.
	* runtime/in_unpack_generic.c (internal_unpack):  Likewise.
	* intrinsics/iso_c_binding.c (c_f_pointer_u0):  Take care
	of stride in "shape" argument.  Use array access macros for
	accessing array descriptors.
	* libgfortran.h (struct descriptor_dimension):  Change stride
	to _stride, lbound to _lbound and ubound to _ubound.
	(GFC_DIMENSION_LBOUND):  Use new name(s) in struct
	descriptor_dimension.
	(GFC_DIMENSION_UBOUND):  Likewise.
	(GFC_DIMENSION_STRIDE):  Likewise.
	(GFC_DIMENSION_EXTENT):  Likewise.
	(GFC_DIMENSION_SET):  Likewise.
	(GFC_DESCRIPTOR_LBOUND):  Likewise.
	(GFC_DESCRIPTOR_UBOUND):  Likewise.
	(GFC_DESCRIPTOR_EXTENT):  Likewise.
	(GFC_DESCRIPTOR_STRIDE):  Likewise.
	* io/transfer.c (transfer_array):  Use array access macros.
	Use byte-sized strides.

2009-05-28  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.

Index: runtime/in_pack_generic.c
===================================================================
--- runtime/in_pack_generic.c	(revision 147329)
+++ runtime/in_pack_generic.c	(working copy)
@@ -48,12 +48,6 @@ internal_pack (gfc_array_char * source)
   index_type size;
   index_type type_size;
 
-  if (source->dim[0].stride == 0)
-    {
-      source->dim[0].stride = 1;
-      return source->data;
-    }
-
   type_size = GFC_DTYPE_TYPE_SIZE(source);
   size = GFC_DESCRIPTOR_SIZE (source);
   switch (type_size)
Index: runtime/in_unpack_generic.c
===================================================================
--- runtime/in_unpack_generic.c	(revision 147329)
+++ runtime/in_unpack_generic.c	(working copy)
@@ -162,9 +162,6 @@ internal_unpack (gfc_array_char * d, con
 
   size = GFC_DESCRIPTOR_SIZE (d);
 
-  if (d->dim[0].stride == 0)
-    d->dim[0].stride = 1;
-
   dim = GFC_DESCRIPTOR_RANK (d);
   dsize = 1;
   for (n = 0; n < dim; n++)
Index: intrinsics/iso_c_binding.c
===================================================================
--- intrinsics/iso_c_binding.c	(revision 147329)
+++ intrinsics/iso_c_binding.c	(working copy)
@@ -75,9 +75,8 @@ ISO_C_BINDING_PREFIX (c_f_pointer) (void
 
 
 /* A generic function to set the common fields of all descriptors, no
-   matter whether it's to a scalar or an array.  Fields set are: data,
-   and if appropriate, rank, offset, dim[*].lbound, dim[*].ubound, and
-   dim[*].stride.  Parameter shape is a rank 1 array of integers
+   matter whether it's to a scalar or an array.  Access is via the array
+   descrptor macros. Parameter shape is a rank 1 array of integers
    containing the upper bound of each dimension of what f_ptr_out
    points to.  The length of this array must be EXACTLY the rank of
    what f_ptr_out points to, as required by the draft (J3/04-007).  If
@@ -95,52 +94,60 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (v
 
   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 = GFC_DESCRIPTOR_STRIDE_BYTES(shape,0);
+
       /* shape's length (rank of the output array) */
-      shapeSize = shape->dim[0].ubound + 1 - shape->dim[0].lbound;
+      shapeSize = GFC_DESCRIPTOR_EXTENT(shape,0);
       for (i = 0; i < shapeSize; i++)
         {
-          /* Lower bound is 1, as specified by the draft.  */
-          f_ptr_out->dim[i].lbound = 1;
+	  index_type str, ub;
+
           /* 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)
+	    ub = *((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)
+	    ub = *((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)
+	    ub = *((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)
+	    ub = *((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		
-        }
+	  if (size == 16)
+	    ub = *((GFC_INTEGER_16 *) p);
+#endif
+	  p += source_stride;
 
-      /* 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 (i == 0)
+	    {
+	      str = 1;
+	      f_ptr_out->offset = str;
+	    }
+	  else
+	    {
+	      str = GFC_DESCRIPTOR_EXTENT(f_ptr_out,i-1);
+	      f_ptr_out->offset += str;
+	    }
+
+          /* Lower bound is 1, as specified by the draft.  */
+	  GFC_DIMENSION_SET(f_ptr_out->dim[i], 1, ub, str);
         }
 
       f_ptr_out->offset *= -1;
Index: libgfortran.h
===================================================================
--- libgfortran.h	(revision 147329)
+++ libgfortran.h	(working copy)
@@ -297,9 +297,9 @@ internal_proto(big_endian);
 
 typedef struct descriptor_dimension
 {
-  index_type stride;
-  index_type lbound;
-  index_type ubound;
+  index_type _stride;
+  index_type _lbound;
+  index_type _ubound;
 }
 
 descriptor_dimension;
@@ -354,27 +354,27 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DI
 #define GFC_DESCRIPTOR_DATA(desc) ((desc)->data)
 #define GFC_DESCRIPTOR_DTYPE(desc) ((desc)->dtype)
 
-#define GFC_DIMENSION_LBOUND(dim) ((dim).lbound)
-#define GFC_DIMENSION_UBOUND(dim) ((dim).ubound)
-#define GFC_DIMENSION_STRIDE(dim) ((dim).stride)
-#define GFC_DIMENSION_EXTENT(dim) ((dim).ubound + 1 - (dim).lbound)
+#define GFC_DIMENSION_LBOUND(dim) ((dim)._lbound)
+#define GFC_DIMENSION_UBOUND(dim) ((dim)._ubound)
+#define GFC_DIMENSION_STRIDE(dim) ((dim)._stride)
+#define GFC_DIMENSION_EXTENT(dim) ((dim)._ubound + 1 - (dim)._lbound)
 #define GFC_DIMENSION_SET(dim,lb,ub,str) \
   do \
     { \
-      (dim).lbound = lb;			\
-      (dim).ubound = ub;			\
-      (dim).stride = str;			\
+      (dim)._lbound = lb;			\
+      (dim)._ubound = ub;			\
+      (dim)._stride = str;			\
     } while (0)
 	    
 
-#define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i].lbound)
-#define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i].ubound)
-#define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i].ubound + 1 \
-				      - (desc)->dim[i].lbound)
+#define GFC_DESCRIPTOR_LBOUND(desc,i) ((desc)->dim[i]._lbound)
+#define GFC_DESCRIPTOR_UBOUND(desc,i) ((desc)->dim[i]._ubound)
+#define GFC_DESCRIPTOR_EXTENT(desc,i) ((desc)->dim[i]._ubound + 1 \
+				      - (desc)->dim[i]._lbound)
 #define GFC_DESCRIPTOR_EXTENT_BYTES(desc,i) \
   (GFC_DESCRIPTOR_EXTENT(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
 
-#define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i].stride)
+#define GFC_DESCRIPTOR_STRIDE(desc,i) ((desc)->dim[i]._stride)
 #define GFC_DESCRIPTOR_STRIDE_BYTES(desc,i) \
   (GFC_DESCRIPTOR_STRIDE(desc,i) * GFC_DESCRIPTOR_SIZE(desc))
 
Index: io/transfer.c
===================================================================
--- io/transfer.c	(revision 147329)
+++ io/transfer.c	(working copy)
@@ -1778,9 +1778,7 @@ transfer_array (st_parameter_dt *dtp, gf
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
-      stride[n] = iotype == BT_CHARACTER ?
-		  desc->dim[n].stride * GFC_SIZE_OF_CHAR_KIND(kind) :
-		  desc->dim[n].stride;
+      stride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(desc,n);
       extent[n] = GFC_DESCRIPTOR_EXTENT(desc,n);
 
       /* If the extent of even one dimension is zero, then the entire
@@ -1797,9 +1795,9 @@ transfer_array (st_parameter_dt *dtp, gf
 
   stride0 = stride[0];
 
-  /* If the innermost dimension has stride 1, we can do the transfer
+  /* If the innermost dimension has a stride of 1, we can do the transfer
      in contiguous chunks.  */
-  if (stride0 == 1)
+  if (stride0 == size)
     tsize = extent[0];
   else
     tsize = 1;
@@ -1809,13 +1807,13 @@ transfer_array (st_parameter_dt *dtp, gf
   while (data)
     {
       dtp->u.p.transfer (dtp, iotype, data, kind, size, tsize);
-      data += stride0 * size * tsize;
+      data += stride0 * tsize;
       count[0] += tsize;
       n = 0;
       while (count[n] == extent[n])
 	{
 	  count[n] = 0;
-	  data -= stride[n] * extent[n] * size;
+	  data -= stride[n] * extent[n];
 	  n++;
 	  if (n == rank)
 	    {
@@ -1825,7 +1823,7 @@ transfer_array (st_parameter_dt *dtp, gf
 	  else
 	    {
 	      count[n]++;
-	      data += stride[n] * size;
+	      data += stride[n];
 	    }
 	}
     }