re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])

2011-05-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * trans-array.c (gfc_walk_variable_expr): Continue walking
        for scalar coarrays.
        * trans-intrinsic.c (convert_element_to_coarray_ref): New
        * function.
        (trans_this_image, trans_image_index, conv_intrinsic_cobound): Use it.
        (trans_this_image): Fix algorithm.
        * trans-types.c (gfc_get_element_type,
        * gfc_get_array_descriptor_base,
        gfc_sym_type): Handle scalar coarrays.

2011-05-06  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.dg/coarray/this_image_2.f90: New.

From-SVN: r173506

4 files changed, 49 insertions, 11 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e53be65..e80bfd3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,16 @@
 2011-05-06  Tobias Burnus  <burnus@net-b.de>
 
+	PR fortran/18918
+	* trans-array.c (gfc_walk_variable_expr): Continue walking
+	for scalar coarrays.
+	* trans-intrinsic.c (convert_element_to_coarray_ref): New function.
+	(trans_this_image, trans_image_index, conv_intrinsic_cobound): Use it.
+	(trans_this_image): Fix algorithm.
+	* trans-types.c (gfc_get_element_type, gfc_get_array_descriptor_base,
+	gfc_sym_type): Handle scalar coarrays.
+
+2011-05-06  Tobias Burnus  <burnus@net-b.de>
+
 	PR fortran/48858
 	PR fortran/48820
 	* lang.opt (std=f2008tr): New.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a7e5f81..1a4ab39 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7443,7 +7443,7 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
 
       ar = &ref->u.ar;
 
-      if (ar->as->rank == 0)
+      if (ar->as->rank == 0 && ref->next != NULL)
 	{
 	  /* Scalar coarray.  */
 	  continue;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 6554df0..345b450 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -921,6 +921,24 @@ gfc_conv_intrinsic_exponent (gfc_se *se, gfc_expr *expr)
 }
 
 
+/* Convert the last ref of a scalar coarray from an AR_ELEMENT to an
+   AR_FULL, suitable for the scalarizer.  */
+
+static void
+convert_element_to_coarray_ref (gfc_expr *expr)
+{
+  gfc_ref *ref;
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->next == NULL
+	&& ref->u.ar.codimen)
+      {
+	ref->u.ar.type = AR_FULL;
+	break;
+      }
+}
+
+
 static void
 trans_this_image (gfc_se * se, gfc_expr *expr)
 {
@@ -951,6 +969,8 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
 
   /* Obtain the descriptor of the COARRAY.  */
   gfc_init_se (&argse, NULL);
+  if (expr->value.function.actual->expr->rank == 0)
+    convert_element_to_coarray_ref (expr->value.function.actual->expr);
   ss = gfc_walk_expr (expr->value.function.actual->expr);
   gcc_assert (ss != gfc_ss_terminator);
   ss->data.info.codimen = corank;
@@ -970,7 +990,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
       dim_arg = se->loop->loopvar[0];
       dim_arg = fold_build2_loc (input_location, PLUS_EXPR,
 				 gfc_array_index_type, dim_arg,
-				 gfc_rank_cst[rank]);
+				 build_int_cst (TREE_TYPE (dim_arg), 1));
       gfc_advance_se_ss_chain (se);
     }
   else
@@ -1016,7 +1036,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
 
      m = this_images() - 1
      i = rank
-     min_var = min (corank - 2, dim_arg)
+     min_var = min (rank + corank - 2, rank + dim_arg - 1)
      for (;;)
        {
 	 extent = gfc_extent(i)
@@ -1042,10 +1062,13 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
 		       build_int_cst (type, 1));
   gfc_add_modify (&se->pre, m, tmp);
 
-  /* min_var = min (rank+corank-2, dim_arg).  */
+  /* min_var = min (rank + corank-2, rank + dim_arg - 1).  */
+  tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
+			 fold_convert (integer_type_node, dim_arg),
+			 build_int_cst (integer_type_node, rank - 1));
   tmp = fold_build2_loc (input_location, MIN_EXPR, integer_type_node,
 			 build_int_cst (integer_type_node, rank + corank - 2),
-			 fold_convert (integer_type_node, dim_arg));
+			 tmp);
   gfc_add_modify (&se->pre, min_var, tmp);
 
   /* i = rank.  */
@@ -1102,9 +1125,9 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
 			  build_int_cst (TREE_TYPE (dim_arg), corank));
 
   lbound = gfc_conv_descriptor_lbound_get (desc,
-			fold_build2_loc (input_location, PLUS_EXPR,
-					 gfc_array_index_type, dim_arg,
-					 gfc_rank_cst[rank - 1]));
+		fold_build2_loc (input_location, PLUS_EXPR,
+				 gfc_array_index_type, dim_arg,
+				 build_int_cst (TREE_TYPE (dim_arg), rank-1)));
   lbound = fold_convert (type, lbound);
 
   tmp = fold_build2_loc (input_location, MINUS_EXPR, type, ml,
@@ -1133,6 +1156,8 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
 
   /* Obtain the descriptor of the COARRAY.  */
   gfc_init_se (&argse, NULL);
+  if (expr->value.function.actual->expr->rank == 0)
+    convert_element_to_coarray_ref (expr->value.function.actual->expr);
   ss = gfc_walk_expr (expr->value.function.actual->expr);
   gcc_assert (ss != gfc_ss_terminator);
   ss->data.info.codimen = corank;
@@ -1457,6 +1482,8 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
   gcc_assert (arg->expr->expr_type == EXPR_VARIABLE);
   corank = gfc_get_corank (arg->expr);
 
+  if (expr->value.function.actual->expr->rank == 0)
+    convert_element_to_coarray_ref (expr->value.function.actual->expr);
   ss = gfc_walk_expr (arg->expr);
   gcc_assert (ss != gfc_ss_terminator);
   ss->data.info.codimen = corank;
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index cc82037..22a2c5b 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1205,7 +1205,7 @@ gfc_get_element_type (tree type)
 int
 gfc_is_nodesc_array (gfc_symbol * sym)
 {
-  gcc_assert (sym->attr.dimension);
+  gcc_assert (sym->attr.dimension || sym->attr.codimension);
 
   /* We only want local arrays.  */
   if (sym->attr.pointer || sym->attr.allocatable)
@@ -1598,7 +1598,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
   char name[16 + 2*GFC_RANK_DIGITS + 1 + 1];
   int idx = 2 * (codimen + dimen - 1) + restricted;
 
-  gcc_assert (dimen >= 1 && codimen + dimen <= GFC_MAX_DIMENSIONS);
+  gcc_assert (codimen + dimen >= 1 && codimen + dimen <= GFC_MAX_DIMENSIONS);
   if (gfc_array_descriptor_base[idx])
     return gfc_array_descriptor_base[idx];
 
@@ -1996,7 +1996,7 @@ gfc_sym_type (gfc_symbol * sym)
   if (!restricted)
     type = gfc_nonrestricted_type (type);
 
-  if (sym->attr.dimension)
+  if (sym->attr.dimension || sym->attr.codimension)
     {
       if (gfc_is_nodesc_array (sym))
         {