[Fortran] Fix handling of polymorphic coarrays and coarray components

2014-04-27  Tobias Burnus  <burnus@net-b.de>

	* trans-expr.c (get_tree_for_caf_expr): Fix handling of polymorphic
	and derived-type coarrays.

2014-04-27  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/coarray_poly_4.f90: New.
	* gfortran.dg/coarray_poly_5.f90: New.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index d6f820c..f0e5b7d 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1387,25 +1387,42 @@  gfc_get_expr_charlen (gfc_expr *e)
 static tree
 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 (comp->attr.codimension)
-	  caf_decl = comp->backend_decl;
-       }
 
-   gcc_assert (caf_decl != NULL_TREE);
-   return caf_decl;
+	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)
+	  {
+	    found = true;
+	    break;
+	  }
+      }
+  gcc_assert (found && caf_decl);
+  return caf_decl;
 }
 
 
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_4.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_4.f90
new file mode 100644
index 0000000..ceb1c85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_4.f90
@@ -0,0 +1,23 @@ 
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+
+subroutine test(i)
+type t
+  real, allocatable :: x[:]
+end type t
+
+interface
+  subroutine sub(y)
+    import
+    real :: y[*]
+  end subroutine sub
+end interface
+
+integer :: i
+type(t), save :: var
+allocate(var%x[*])
+call sub(var%x)
+end subroutine test
+
+! { dg-final { scan-tree-dump-times "sub \\(\\(real\\(kind=4\\) \\*\\) var.x.data, var.x.token, 0\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_5.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_5.f90
new file mode 100644
index 0000000..29c9c8c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_poly_5.f90
@@ -0,0 +1,14 @@ 
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+
+subroutine test(x)
+type t
+  real, allocatable :: x[:]
+end type t
+
+class(t) :: x
+allocate(x%x[*])
+end subroutine test
+
+! { dg-final { scan-tree-dump-times "x->_data->x.data = _gfortran_caf_register \\(4, 1, &x->_data->x.token, 0B, 0B, 0\\);" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }