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 <bur...@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 <bur...@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;
}
