1 files changed, 18 insertions, 33 deletions

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index be138d1..d3a1f8c 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -1320,6 +1320,7 @@ simplify_intrinsic_op (gfc_expr *p, int type)
     }
 
   result->rank = p->rank;
+  result->corank = p->corank;
   result->where = p->where;
   gfc_replace_expr (p, result);
 
@@ -2161,6 +2162,7 @@ simplify_parameter_variable (gfc_expr *p, int type)
       e->expr_type = EXPR_ARRAY;
       e->ts = p->ts;
       e->rank = p->rank;
+      e->corank = p->corank;
       e->value.constructor = NULL;
       e->shape = gfc_copy_shape (p->shape, p->rank);
       e->where = p->where;
@@ -2181,6 +2183,7 @@ simplify_parameter_variable (gfc_expr *p, int type)
       gfc_free_shape (&e->shape, e->rank);
       e->shape = gfc_copy_shape (p->shape, p->rank);
       e->rank = p->rank;
+      e->corank = p->corank;
 
       if (e->ts.type == BT_CHARACTER && p->ts.u.cl)
 	e->ts = p->ts;
@@ -4596,7 +4599,10 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
   lvalue.expr_type = EXPR_VARIABLE;
   lvalue.ts = sym->ts;
   if (sym->as)
-    lvalue.rank = sym->as->rank;
+    {
+      lvalue.rank = sym->as->rank;
+      lvalue.corank = sym->as->corank;
+    }
   lvalue.symtree = XCNEW (gfc_symtree);
   lvalue.symtree->n.sym = sym;
   lvalue.where = sym->declared_at;
@@ -4609,6 +4615,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
       lvalue.ref->u.c.sym = sym;
       lvalue.ts = comp->ts;
       lvalue.rank = comp->as ? comp->as->rank : 0;
+      lvalue.corank = comp->as ? comp->as->corank : 0;
       lvalue.where = comp->loc;
       pointer = comp->ts.type == BT_CLASS &&  CLASS_DATA (comp)
 		? CLASS_DATA (comp)->attr.class_pointer : comp->attr.pointer;
@@ -5261,14 +5268,15 @@ gfc_get_variable_expr (gfc_symtree *var)
 	       && CLASS_DATA (var->n.sym)
 	       && CLASS_DATA (var->n.sym)->as)))
     {
-      e->rank = var->n.sym->ts.type == BT_CLASS
-		? CLASS_DATA (var->n.sym)->as->rank : var->n.sym->as->rank;
+      gfc_array_spec *as = var->n.sym->ts.type == BT_CLASS
+			     ? CLASS_DATA (var->n.sym)->as
+			     : var->n.sym->as;
+      e->rank = as->rank;
+      e->corank = as->corank;
       e->ref = gfc_get_ref ();
       e->ref->type = REF_ARRAY;
       e->ref->u.ar.type = AR_FULL;
-      e->ref->u.ar.as = gfc_copy_array_spec (var->n.sym->ts.type == BT_CLASS
-					     ? CLASS_DATA (var->n.sym)->as
-					     : var->n.sym->as);
+      e->ref->u.ar.as = gfc_copy_array_spec (as);
     }
 
   return e;
@@ -5297,6 +5305,8 @@ gfc_add_full_array_ref (gfc_expr *e, gfc_array_spec *as)
   ref->type = REF_ARRAY;
   ref->u.ar.type = AR_FULL;
   ref->u.ar.dimen = e->rank;
+  /* Do not set the corank here, or resolve will not be able to set correct
+     dimen-types for the coarray.  */
   ref->u.ar.where = e->where;
   ref->u.ar.as = as;
 }
@@ -5316,7 +5326,8 @@ gfc_lval_expr_from_sym (gfc_symbol *sym)
   /* It will always be a full array.  */
   as = IS_CLASS_ARRAY (sym) ? CLASS_DATA (sym)->as : sym->as;
   lval->rank = as ? as->rank : 0;
-  if (lval->rank)
+  lval->corank = as ? as->corank : 0;
+  if (lval->rank || lval->corank)
     gfc_add_full_array_ref (lval, as);
   return lval;
 }
@@ -5872,32 +5883,6 @@ gfc_is_coarray (gfc_expr *e)
 }
 
 
-int
-gfc_get_corank (gfc_expr *e)
-{
-  int corank;
-  gfc_ref *ref;
-
-  if (!gfc_is_coarray (e))
-    return 0;
-
-  if (e->ts.type == BT_CLASS && CLASS_DATA (e))
-    corank = CLASS_DATA (e)->as
-	     ? CLASS_DATA (e)->as->corank : 0;
-  else
-    corank = e->symtree->n.sym->as ? e->symtree->n.sym->as->corank : 0;
-
-  for (ref = e->ref; ref; ref = ref->next)
-    {
-      if (ref->type == REF_ARRAY)
-	corank = ref->u.ar.as->corank;
-      gcc_assert (ref->type != REF_SUBSTRING);
-    }
-
-  return corank;
-}
-
-
 /* Check whether the expression has an ultimate allocatable component.
    Being itself allocatable does not count.  */
 bool