[Fortran-dev][Patch, Fortran] C_F_Pointer cleanup

[Tobias Burnus <burnus at net-b dot de>]

Dear all,

that's a follow up cleanup to the patch, which has just been merged. 
Most parts should be really obvious and nice, however, the offset part 
isn't. As the offset is not part of the descriptor defined at DTS 
29113:2012's "8.2 C descriptors" (p. 17), we will have to drop it at 
some point. Hence, I used the less readable name "tmp" and an integer 
divide, instead of multiplying "stride" by "tmp" when setting the "sm" 
and changing "tmp" to, e.g., "size".

Bootstrapped (with C) and regtested on x86-64-linux.
OK for the branch?

Currently failing are the following 14 (13) test cases:

gfortran.dg/optional_dim_3.f90 (I have a patch)

gfortran.dg/associated_2.f90
gfortran.dg/auto_char_dummy_array_1.f90
gfortran.dg/auto_char_len_3.f90
gfortran.dg/class_array_1.f03
gfortran.dg/class_array_2.f03
gfortran.dg/class_array_3.f03
gfortran.dg/class_to_type_1.f03
gfortran.dg/proc_decl_23.f90
gfortran.dg/select_type_26.f03
gfortran.dg/select_type_27.f03
gfortran.dg/read_eof_all.f90
gfortran.dg/transfer_intrinsic_3.f90
gfortran.dg/subref_array_pointer_2.f90

(Plus gfortran.dg/lto/pr45586 and gfortran.dg/realloc_on_assign_5.f03, 
but those also fail on the trunk.)

Tobias
2012-07-15  Tobias Burnus  <burnus@net-b.de>

	* trans-expr.c (conv_isocbinding_procedure): For C_F_Pointer,
	directly set extent and sm instead of using ubound and stride.

2012-07-15  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/c_f_pointer_tests_3.f90: Update scan-tree-dump
	pattern.

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 189481)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -3315,7 +3315,7 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbo
       gfc_se fptrse;
       gfc_se shapese;
       gfc_ss *ss, *shape_ss;
-      tree desc, dim, tmp, stride, offset;
+      tree desc, dim, tmp, sm, offset;
       stmtblock_t body, block;
       gfc_loopinfo loop;
 
@@ -3378,9 +3378,10 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbo
       gfc_copy_loopinfo_to_se (&shapese, &loop);
       shapese.ss = shape_ss;
 
-      stride = gfc_create_var (gfc_array_index_type, "stride");
+      sm = gfc_create_var (gfc_array_index_type, "sm");
       offset = gfc_create_var (gfc_array_index_type, "offset");
-      gfc_add_modify (&block, stride, gfc_index_one_node);
+      tmp = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)));
+      gfc_add_modify (&block, sm, fold_convert (TREE_TYPE (sm), tmp));
       gfc_add_modify (&block, offset, gfc_index_zero_node);
 
       /* Loop body.  */
@@ -3389,23 +3390,27 @@ conv_isocbinding_procedure (gfc_se * se, gfc_symbo
       dim = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
 			     loop.loopvar[0], loop.from[0]);
 
-      /* Set bounds and stride. */
+      /* Set bounds and stride multiplier. */
       gfc_conv_descriptor_lbound_set (&body, desc, dim, gfc_index_one_node);
-      gfc_conv_descriptor_stride_set (&body, desc, dim, stride);
+      gfc_conv_descriptor_sm_set (&body, desc, dim, sm);
 
       gfc_conv_expr (&shapese, arg->next->next->expr);
       gfc_add_block_to_block (&body, &shapese.pre);
-      gfc_conv_descriptor_ubound_set (&body, desc, dim, shapese.expr);
+      gfc_conv_descriptor_extent_set (&body, desc, dim, shapese.expr);
       gfc_add_block_to_block (&body, &shapese.post);
 
-      /* Calculate offset. */
+      /* Calculate offset. Change from the stride multiplier back to the
+	 stride.  */
+      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			     gfc_array_index_type, sm,
+			     fold_convert (TREE_TYPE (sm), tmp));
       gfc_add_modify (&body, offset,
 		      fold_build2_loc (input_location, PLUS_EXPR,
-				       gfc_array_index_type, offset, stride));
+				       gfc_array_index_type, offset, tmp));
       /* Update stride.  */
-      gfc_add_modify (&body, stride,
+      gfc_add_modify (&body, sm,
 		      fold_build2_loc (input_location, MULT_EXPR,
-				       gfc_array_index_type, stride,
+				       gfc_array_index_type, sm,
 				       fold_convert (gfc_array_index_type,
 						     shapese.expr)));
       /* Finish scalarization loop.  */ 
Index: gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90	(Revision 189481)
+++ gcc/testsuite/gfortran.dg/c_f_pointer_tests_3.f90	(Arbeitskopie)
@@ -31,10 +31,10 @@ end program test
 !
 ! Array c_f_pointer:
 !
-! { dg-final { scan-tree-dump-times " fptr_array.data = cptr;" 1 "original" } }
-! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].lbound = 1;" 1 "original" } }
-! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].ubound = " 1 "original" } }
-! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].stride = " 1 "original" } }
+! { dg-final { scan-tree-dump-times " fptr_array.base_addr = cptr;" 1 "original" } }
+! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].lower_bound = 1;" 1 "original" } }
+! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].extent = " 1 "original" } }
+! { dg-final { scan-tree-dump-times " fptr_array.dim\\\[S..\\\].sm = " 1 "original" } }
 !
 ! Check c_f_procpointer
 ! { dg-final { scan-tree-dump-times "  fprocptr = .integer.kind=4. .\\*<.*>. ... cfunptr;" 1 "original" } }