[fortran-caf, patch, committed] Fix bugs, prepare for GET/PULL support

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

Hi all,

the attached and committed (Rev. 209348) patch fixes two issues and 
prepares for pulling (getting) data from remote hosts by inserting an 
intrinsic function (inaccessible from the outside) when a coindexed 
expression is used. The code is a bit eager as it also adds it to the 
LHS of an assignment and in an allocate/deallocate statement - hence, I 
remove the intrinsic. I have a draft patch for trans-intrinsic.c, but I 
still need to clean it up.

The two issues, which the patch fixes were:

* When one has a coarray which is a component of a derived type, one 
also needs to include the variable when accessing it, not only the the 
tree decl of the component. And also polymorphic types have to be handled.

* For automatic arrays, the whole initialization got lost, leading to 
zero-sized arrays which shouldn't be zero sized. Let's hope that there 
are not too many similar bugs still lurking in the code.

Tobias

Index: ChangeLog.fortran-caf
===================================================================
--- ChangeLog.fortran-caf	(Revision 209347)
+++ ChangeLog.fortran-caf	(Arbeitskopie)
@@ -1,3 +1,15 @@
+2014-04-13  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-decl.c (gfc_trans_deferred_vars): Fix bug in
+	condition.
+	* trans-expr.c (gfc_get_tree_for_caf_expr): Handle polymorphism
+	and coarray components of derived types.
+	* resolve.c (add_caf_get_intrinsic, remove_caf_get_intrinsic): New.
+	(resolve_variable, resolve_allocate_expr, resolve_code): Use it;
+	currently disabled.
+	(gfc_resolve_expr): Moved expression_rank call into
+	resolve_variable.
+
 2014-04-10  Tobias Burnus  <burnus@net-b.de>
 
 	* trans-intrinsic.c (caf_get_image_index, conv_caf_send):
Index: trans-decl.c
===================================================================
--- trans-decl.c	(Revision 209347)
+++ trans-decl.c	(Arbeitskopie)
@@ -3798,7 +3798,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gf
 					NULL_TREE);
 		  continue;
 		}
-	      else if (gfc_option.coarray != GFC_FCOARRAY_LIB)
+	      else if (gfc_option.coarray != GFC_FCOARRAY_LIB
+		       || !sym->attr.codimension)
 		{
 		  gfc_save_backend_locus (&loc);
 		  gfc_set_backend_locus (&sym->declared_at);
Index: resolve.c
===================================================================
--- resolve.c	(Revision 209347)
+++ resolve.c	(Arbeitskopie)
@@ -4728,6 +4728,40 @@ done:
 }
 
 
+static void
+add_caf_get_intrinsic (gfc_expr *e)
+{
+  gfc_expr *wrapper, *tmp_expr;
+  gfc_expr *async = gfc_get_logical_expr (gfc_default_logical_kind, NULL,
+					  false);
+  tmp_expr = XCNEW (gfc_expr);
+  *tmp_expr = *e;
+  wrapper = gfc_build_intrinsic_call (gfc_current_ns, GFC_ISYM_CAF_GET,
+				      "caf_get", tmp_expr->where, 2,
+				      tmp_expr, async);
+  wrapper->ts = e->ts;
+  wrapper->rank = e->rank;
+  if (e->rank)
+    wrapper->shape = gfc_copy_shape (e->shape, e->rank);
+  *e = *wrapper;
+  free (wrapper);
+}
+
+
+static void
+remove_caf_get_intrinsic (gfc_expr *e)
+{
+  gcc_assert (e->expr_type == EXPR_FUNCTION && e->value.function.isym
+	      && e->value.function.isym->id == GFC_ISYM_CAF_GET);
+  gfc_expr *e2 = e->value.function.actual->expr;
+  e->value.function.actual->expr =NULL;
+  gfc_free_actual_arglist (e->value.function.actual);
+  gfc_free_shape (&e->shape, e->rank);
+  *e = *e2;
+  free (e2);
+}
+
+
 /* Resolve a variable expression.  */
 
 static bool
@@ -5007,6 +5041,12 @@ resolve_procedure:
 	}
     }
 
+  if (t)
+    expression_rank (e);
+
+  if (0 && t && gfc_option.coarray == GFC_FCOARRAY_LIB && gfc_is_coindexed (e))
+    add_caf_get_intrinsic(e);
+
   return t;
 }
 
@@ -6090,11 +6130,7 @@ gfc_resolve_expr (gfc_expr *e)
       if (check_host_association (e))
 	t = resolve_function (e);
       else
-	{
-	  t = resolve_variable (e);
-	  if (t)
-	    expression_rank (e);
-	}
+	t = resolve_variable (e);
 
       if (e->ts.type == BT_CHARACTER && e->ts.u.cl == NULL && e->ref
 	  && e->ref->type != REF_SUBSTRING)
@@ -6673,6 +6709,10 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code
   if (!gfc_resolve_expr (e))
     goto failure;
 
+  if (e->expr_type == EXPR_FUNCTION && e->value.function.isym
+      && e->value.function.isym->id == GFC_ISYM_CAF_GET)
+    remove_caf_get_intrinsic (e);
+
   /* Make sure the expression is allocatable or a pointer.  If it is
      pointer, the next-to-last reference must be a pointer.  */
 
@@ -9867,6 +9907,11 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
 	  if (!t)
 	    break;
 
+	  if (code->expr1->expr_type == EXPR_FUNCTION
+	      && code->expr1->value.function.isym
+	      && code->expr1->value.function.isym->id == GFC_ISYM_CAF_GET)
+	    remove_caf_get_intrinsic (code->expr1);
+
 	  if (!gfc_check_vardef_context (code->expr1, false, false, false, 
 					 _("assignment")))
 	    break;
Index: trans-expr.c
===================================================================
--- trans-expr.c	(Revision 209347)
+++ trans-expr.c	(Arbeitskopie)
@@ -1386,25 +1386,42 @@ gfc_get_expr_charlen (gfc_expr *e)
 tree
 gfc_get_tree_for_caf_expr (gfc_expr *expr)
 {
-   tree caf_decl = NULL_TREE;
-   gfc_ref *ref;
+  tree caf_decl;
+  bool found;
+  gfc_ref *ref;
 
-   gcc_assert (expr && expr->expr_type == EXPR_VARIABLE);
-   if (expr->symtree->n.sym->attr.codimension)
-     caf_decl = expr->symtree->n.sym->backend_decl;
+  gcc_assert (expr && expr->expr_type == EXPR_VARIABLE);
 
-   for (ref = expr->ref; ref; ref = ref->next)
-     if (ref->type == REF_COMPONENT)
-       {
+  caf_decl = expr->symtree->n.sym->backend_decl;
+  gcc_assert (caf_decl);
+  if (expr->symtree->n.sym->ts.type == BT_CLASS)
+    caf_decl = gfc_class_data_get (caf_decl);
+  if (expr->symtree->n.sym->attr.codimension)
+    return caf_decl;
+
+  /* The following code assumes that the coarray is a component reachable via
+     only scalar components/variables; the Fortran standard guarantees this.  */
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT)
+      {
 	gfc_component *comp = ref->u.c.component;
-        if (comp->attr.pointer || comp->attr.allocatable)
-	  caf_decl = NULL_TREE;
+
+	if (POINTER_TYPE_P (TREE_TYPE (caf_decl)))
+	  caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
+	caf_decl = fold_build3_loc (input_location, COMPONENT_REF,
+				    TREE_TYPE (comp->backend_decl), caf_decl,
+				    comp->backend_decl, NULL_TREE);
+	if (comp->ts.type == BT_CLASS)
+	  caf_decl = gfc_class_data_get (caf_decl);
 	if (comp->attr.codimension)
-	  caf_decl = comp->backend_decl;
-       }
-
-   gcc_assert (caf_decl != NULL_TREE);
-   return caf_decl;
+	  {
+	    found = true;
+	    break;
+	  }
+      }
+  gcc_assert (found && caf_decl);
+  return caf_decl;
 }