trans-expr.c (get_tree_for_caf_expr): Fix handling of

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

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

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

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

From-SVN: r209948

gcc/fortran/ChangeLog

@@ -1,4 +1,9 @@
-2014-03-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
+2014-04-30  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  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/59604
 	PR fortran/58003

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;
 }
 
 

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2014-04-30  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.dg/coarray_poly_4.f90: New.
+	* gfortran.dg/coarray_poly_5.f90: New.
+
 2014-04-30  Alan Lawrence  <alan.lawrence@arm.com>
 
 	* gcc.target/arm/simd/vuzpqf32_1.c: New file.

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" } }

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" } }