Add corank to gfc_expr.

Compute the corank of an expression along side to the regular rank.
This safe costly calls to gfc_get_corank (), which consecutively has
been removed.  In some locations the code needed some adaption to model
the difference between expr.corank and gfc_get_corank correctly.  The
latter always returned the codimension of the expression and not its
current corank, i.e. the resolution of all indezes.

This commit is preparatory to fixing PR fortran/110033 and may contain
parts of that fix already.

gcc/fortran/ChangeLog:

	* arith.cc (reduce_unary): Use expr.corank.
	(reduce_binary_ac): Same.
	(reduce_binary_ca): Same.
	(reduce_binary_aa): Same.
	* array.cc (gfc_match_array_ref): Same.
	* check.cc (dim_corank_check): Same.
	(gfc_check_move_alloc): Same.
	(gfc_check_image_index): Same.
	* class.cc (gfc_add_class_array_ref): Same.
	(finalize_component): Same.
	* data.cc (gfc_assign_data_value): Same.
	* decl.cc (match_clist_expr): Same.
	(add_init_expr_to_sym): Same.
	* expr.cc (simplify_intrinsic_op): Same.
	(simplify_parameter_variable): Same.
	(gfc_check_assign_symbol): Same.
	(gfc_get_variable_expr): Same.
	(gfc_add_full_array_ref): Same.
	(gfc_lval_expr_from_sym): Same.
	(gfc_get_corank): Removed.
	* frontend-passes.cc (callback_reduction): Use expr.corank.
	(create_var): Same.
	(combine_array_constructor): Same.
	(optimize_minmaxloc): Same.
	* gfortran.h (gfc_get_corank): Add corank to gfc_expr.
	* intrinsic.cc (gfc_get_intrinsic_function_symbol): Use
	expr.corank.
	(gfc_convert_type_warn): Same.
	(gfc_convert_chartype): Same.
	* iresolve.cc (resolve_bound): Same.
	(gfc_resolve_cshift): Same.
	(gfc_resolve_eoshift): Same.
	(gfc_resolve_logical): Same.
	(gfc_resolve_matmul): Same.
	* match.cc (copy_ts_from_selector_to_associate): Same.
	* matchexp.cc (gfc_get_parentheses): Same.
	* parse.cc (parse_associate): Same.
	* primary.cc (gfc_match_rvalue): Same.
	* resolve.cc (resolve_structure_cons): Same.
	(resolve_actual_arglist): Same.
	(resolve_elemental_actual): Same.
	(resolve_generic_f0): Same.
	(resolve_unknown_f): Same.
	(resolve_operator): Same.
	(gfc_expression_rank): Same and set dimen_type for coarray to
	default.
	(gfc_op_rank_conformable): Use expr.corank.
	(add_caf_get_intrinsic): Same.
	(resolve_variable): Same.
	(gfc_fixup_inferred_type_refs): Same.
	(check_host_association): Same.
	(resolve_compcall): Same.
	(resolve_expr_ppc): Same.
	(resolve_assoc_var): Same.
	(fixup_array_ref): Same.
	(resolve_select_type): Same.
	(add_comp_ref): Same.
	(get_temp_from_expr): Same.
	(resolve_fl_var_and_proc): Same.
	(resolve_symbol): Same.
	* symbol.cc (gfc_is_associate_pointer): Same.
	* trans-array.cc (walk_coarray): Same.
	(gfc_conv_expr_descriptor): Same.
	(gfc_walk_array_ref): Same.
	* trans-array.h (gfc_walk_array_ref): Same.
	* trans-expr.cc (gfc_get_ultimate_alloc_ptr_comps_caf_token):
	Same.
	* trans-intrinsic.cc (trans_this_image): Same.
	(trans_image_index): Same.
	(conv_intrinsic_cobound): Same.
	(gfc_walk_intrinsic_function): Same.
	(conv_intrinsic_move_alloc): Same.
	* trans-stmt.cc (gfc_trans_lock_unlock): Same.
	(trans_associate_var): Same and adapt to slightly different
	behaviour of expr.corank and gfc_get_corank.
	(gfc_trans_allocate): Same.
	* trans.cc (gfc_add_finalizer_call): Same.

23 files changed, 450 insertions, 200 deletions

diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc
index b373c25..19916c10 100644
--- a/gcc/fortran/arith.cc
+++ b/gcc/fortran/arith.cc
@@ -1393,6 +1393,7 @@ reduce_unary (arith (*eval) (gfc_expr *, gfc_expr **), gfc_expr *op,
 	}
       r->shape = gfc_copy_shape (op->shape, op->rank);
       r->rank = op->rank;
+      r->corank = op->corank;
       r->value.constructor = head;
       *result = r;
     }
@@ -1456,6 +1457,7 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
 	  r->shape = gfc_get_shape (op1->rank);
 	}
       r->rank = op1->rank;
+      r->corank = op1->corank;
       r->value.constructor = head;
       *result = r;
     }
@@ -1519,6 +1521,7 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
 	  r->shape = gfc_get_shape (op2->rank);
 	}
       r->rank = op2->rank;
+      r->corank = op2->corank;
       r->value.constructor = head;
       *result = r;
     }
@@ -1585,6 +1588,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
 	}
       r->shape = gfc_copy_shape (op1->shape, op1->rank);
       r->rank = op1->rank;
+      r->corank = op1->corank;
       r->value.constructor = head;
       *result = r;
     }
diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index a5e94f1..1fa61eb 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -203,6 +203,12 @@ gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init,
     {
       ar->type = AR_FULL;
       ar->dimen = 0;
+      if (corank != 0)
+	{
+	  for (int i = 0; i < GFC_MAX_DIMENSIONS; ++i)
+	    ar->dimen_type[i] = DIMEN_THIS_IMAGE;
+	  ar->codimen = corank;
+	}
       return MATCH_YES;
     }
 
@@ -238,7 +244,15 @@ coarray:
   if (!matched_bracket && gfc_match_char ('[') != MATCH_YES)
     {
       if (ar->dimen > 0)
-	return MATCH_YES;
+	{
+	  if (corank != 0)
+	    {
+	      for (int i = ar->dimen; i < GFC_MAX_DIMENSIONS; ++i)
+		ar->dimen_type[i] = DIMEN_THIS_IMAGE;
+	      ar->codimen = corank;
+	    }
+	  return MATCH_YES;
+	}
       else
 	return MATCH_ERROR;
     }
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 2f50d84..ee1e741 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1075,8 +1075,6 @@ dim_check (gfc_expr *dim, int n, bool optional)
 static bool
 dim_corank_check (gfc_expr *dim, gfc_expr *array)
 {
-  int corank;
-
   gcc_assert (array->expr_type == EXPR_VARIABLE);
 
   if (dim->expr_type != EXPR_CONSTANT)
@@ -1085,10 +1083,8 @@ dim_corank_check (gfc_expr *dim, gfc_expr *array)
   if (array->ts.type == BT_CLASS)
     return true;
 
-  corank = gfc_get_corank (array);
-
   if (mpz_cmp_ui (dim->value.integer, 1) < 0
-      || mpz_cmp_ui (dim->value.integer, corank) > 0)
+      || mpz_cmp_ui (dim->value.integer, array->corank) > 0)
     {
       gfc_error ("%<dim%> argument of %qs intrinsic at %L is not a valid "
 		 "codimension index", gfc_current_intrinsic, &dim->where);
@@ -4269,11 +4265,11 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
     }
 
   /* IR F08/0040; cf. 12-006A.  */
-  if (gfc_get_corank (to) != gfc_get_corank (from))
+  if (to->corank != from->corank)
     {
       gfc_error ("The FROM and TO arguments of the MOVE_ALLOC intrinsic at %L "
-		 "must have the same corank %d/%d", &to->where,
-		 gfc_get_corank (from), gfc_get_corank (to));
+		 "must have the same corank %d/%d",
+		 &to->where, from->corank, to->corank);
       return false;
     }
 
@@ -5996,13 +5992,11 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub)
 
   if (gfc_array_size (sub, &nelems))
     {
-      int corank = gfc_get_corank (coarray);
-
-      if (mpz_cmp_ui (nelems, corank) != 0)
+      if (mpz_cmp_ui (nelems, coarray->corank) != 0)
 	{
 	  gfc_error ("The number of array elements of the SUB argument to "
 		     "IMAGE_INDEX at %L shall be %d (corank) not %d",
-		     &sub->where, corank, (int) mpz_get_si (nelems));
+		     &sub->where, coarray->corank, (int) mpz_get_si (nelems));
 	  mpz_clear (nelems);
 	  return false;
 	}
diff --git a/gcc/fortran/class.cc b/gcc/fortran/class.cc
index b9dcc0a..88fbba2 100644
--- a/gcc/fortran/class.cc
+++ b/gcc/fortran/class.cc
@@ -264,10 +264,12 @@ void
 gfc_add_class_array_ref (gfc_expr *e)
 {
   int rank = CLASS_DATA (e)->as->rank;
+  int corank = CLASS_DATA (e)->as->corank;
   gfc_array_spec *as = CLASS_DATA (e)->as;
   gfc_ref *ref = NULL;
   gfc_add_data_component (e);
   e->rank = rank;
+  e->corank = corank;
   for (ref = e->ref; ref; ref = ref->next)
     if (!ref->next)
       break;
@@ -1061,6 +1063,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
       ref->next->u.ar.as = comp->ts.type == BT_CLASS ? CLASS_DATA (comp)->as
 							: comp->as;
       e->rank = ref->next->u.ar.as->rank;
+      e->corank = ref->next->u.ar.as->corank;
       ref->next->u.ar.type = e->rank ? AR_FULL : AR_ELEMENT;
     }
 
diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc
index 7024749..d80ba66 100644
--- a/gcc/fortran/data.cc
+++ b/gcc/fortran/data.cc
@@ -327,6 +327,7 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
 	      /* Setup the expression to hold the constructor.  */
 	      expr->expr_type = EXPR_ARRAY;
 	      expr->rank = ref->u.ar.as->rank;
+	      expr->corank = ref->u.ar.as->corank;
 	    }
 
 	  if (ref->u.ar.type == AR_ELEMENT)
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index b8308ae..f712a45 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -912,6 +912,7 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as)
 
       /* Set the rank/shape to match the LHS as auto-reshape is implied. */
       expr->rank = as->rank;
+      expr->corank = as->corank;
       expr->shape = gfc_get_shape (as->rank);
       for (int i = 0; i < as->rank; ++i)
 	spec_dimen_size (as, i, &expr->shape[i]);
@@ -2277,6 +2278,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
 	      mpz_clear (size);
 	    }
 	  init->rank = sym->as->rank;
+	  init->corank = sym->as->corank;
 	}
 
       sym->value = init;
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
diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc
index 3c06018..104ccb1 100644
--- a/gcc/fortran/frontend-passes.cc
+++ b/gcc/fortran/frontend-passes.cc
@@ -515,6 +515,7 @@ callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
       new_expr->ts = fn->ts;
       new_expr->expr_type = EXPR_OP;
       new_expr->rank = fn->rank;
+      new_expr->corank = fn->corank;
       new_expr->where = fn->where;
       new_expr->value.op.op = op;
       new_expr->value.op.op1 = res;
@@ -791,6 +792,7 @@ create_var (gfc_expr * e, const char *vname)
     {
       symbol->as = gfc_get_array_spec ();
       symbol->as->rank = e->rank;
+      symbol->as->corank = e->corank;
 
       if (e->shape == NULL)
 	{
@@ -853,6 +855,7 @@ create_var (gfc_expr * e, const char *vname)
   result->ts = symbol->ts;
   result->ts.deferred = deferred;
   result->rank = e->rank;
+  result->corank = e->corank;
   result->shape = gfc_copy_shape (e->shape, e->rank);
   result->symtree = symtree;
   result->where = e->where;
@@ -1839,6 +1842,7 @@ combine_array_constructor (gfc_expr *e)
       new_expr->ts = e->ts;
       new_expr->expr_type = EXPR_OP;
       new_expr->rank = c->expr->rank;
+      new_expr->corank = c->expr->corank;
       new_expr->where = c->expr->where;
       new_expr->value.op.op = e->value.op.op;
 
@@ -2283,6 +2287,7 @@ optimize_minmaxloc (gfc_expr **e)
   *e = gfc_get_array_expr (fn->ts.type, fn->ts.kind, &fn->where);
   (*e)->shape = fn->shape;
   fn->rank = 0;
+  fn->corank = 0;
   fn->shape = NULL;
   gfc_constructor_append_expr (&(*e)->value.constructor, fn, &fn->where);
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 8d89797..729d811 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2571,6 +2571,7 @@ typedef struct gfc_expr
   gfc_typespec ts;	/* These two refer to the overall expression */
 
   int rank;		/* 0 indicates a scalar, -1 an assumed-rank array.  */
+  int corank;		/* same as rank, but for coarrays.  */
   mpz_t *shape;		/* Can be NULL if shape is unknown at compile time */
 
   /* Nonnull for functions and structure constructors, may also used to hold the
@@ -3801,7 +3802,6 @@ bool gfc_is_class_array_function (gfc_expr *);
 bool gfc_ref_this_image (gfc_ref *ref);
 bool gfc_is_coindexed (gfc_expr *);
 bool gfc_is_coarray (gfc_expr *);
-int gfc_get_corank (gfc_expr *);
 bool gfc_has_ultimate_allocatable (gfc_expr *);
 bool gfc_has_ultimate_pointer (gfc_expr *);
 gfc_expr* gfc_find_team_co (gfc_expr *);
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 62c349d..f7cbb4b 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -165,6 +165,7 @@ gfc_get_intrinsic_function_symbol (gfc_expr *expr)
       sym->as = gfc_get_array_spec ();
       sym->as->type = AS_ASSUMED_SHAPE;
       sym->as->rank = expr->rank;
+      sym->as->corank = expr->corank;
     }
   return sym;
 }
@@ -5382,6 +5383,7 @@ gfc_convert_type_warn (gfc_expr *expr, gfc_typespec *ts, int eflag, int wflag,
   new_expr->where = old_where;
   new_expr->ts = *ts;
   new_expr->rank = rank;
+  new_expr->corank = expr->corank;
   new_expr->shape = gfc_copy_shape (shape, rank);
 
   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
@@ -5457,6 +5459,7 @@ gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
   new_expr->where = old_where;
   new_expr->ts = *ts;
   new_expr->rank = rank;
+  new_expr->corank = expr->corank;
   new_expr->shape = gfc_copy_shape (shape, rank);
 
   gfc_get_ha_sym_tree (sym->name, &new_expr->symtree);
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index c63a4a8..753c636 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -152,13 +152,21 @@ resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind,
 
   if (dim == NULL)
     {
-      f->rank = 1;
       if (array->rank != -1)
 	{
-	  f->shape = gfc_get_shape (1);
-	  mpz_init_set_ui (f->shape[0], coarray ? gfc_get_corank (array)
-						: array->rank);
+	  /* Assume f->rank gives the size of the shape, because there is no
+	     other way to determine the size.  */
+	  if (!f->shape || f->rank != 1)
+	    {
+	      if (f->shape)
+		gfc_free_shape (&f->shape, f->rank);
+	      f->shape = gfc_get_shape (1);
+	    }
+	  mpz_init_set_ui (f->shape[0], coarray ? array->corank : array->rank);
 	}
+      /* Applying bound to a coarray always results in a regular array.  */
+      f->rank = 1;
+      f->corank = 0;
     }
 
   f->value.function.name = gfc_get_string ("%s", name);
@@ -748,6 +756,7 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 
   f->ts = array->ts;
   f->rank = array->rank;
+  f->corank = array->corank;
   f->shape = gfc_copy_shape (array->shape, array->rank);
 
   if (shift->rank > 0)
@@ -916,6 +925,7 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
 
   f->ts = array->ts;
   f->rank = array->rank;
+  f->corank = array->corank;
   f->shape = gfc_copy_shape (array->shape, array->rank);
 
   n = 0;
@@ -1554,6 +1564,7 @@ gfc_resolve_logical (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
   f->ts.kind = (kind == NULL)
 	     ? gfc_default_logical_kind : mpz_get_si (kind->value.integer);
   f->rank = a->rank;
+  f->corank = a->corank;
 
   f->value.function.name
     = gfc_get_string ("__logical_%d_%c%d", f->ts.kind,
@@ -1584,6 +1595,7 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b)
     }
 
   f->rank = (a->rank == 2 && b->rank == 2) ? 2 : 1;
+  f->corank = a->corank;
 
   if (a->rank == 2 && b->rank == 2)
     {
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index e4b60bf..d30a98f 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -6328,7 +6328,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector,
 {
   gfc_ref *ref;
   gfc_symbol *assoc_sym;
-  int rank = 0;
+  int rank = 0, corank = 0;
 
   assoc_sym = associate->symtree->n.sym;
 
@@ -6346,6 +6346,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector,
     {
       assoc_sym->attr.dimension = 1;
       assoc_sym->as = gfc_copy_array_spec (CLASS_DATA (selector)->as);
+      corank = assoc_sym->as->corank;
       goto build_class_sym;
     }
   else if (selector->ts.type == BT_CLASS
@@ -6372,13 +6373,20 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector,
 	}
 
       if (!ref || ref->u.ar.type == AR_FULL)
-	selector->rank = CLASS_DATA (selector)->as->rank;
+	{
+	  selector->rank = CLASS_DATA (selector)->as->rank;
+	  selector->corank = CLASS_DATA (selector)->as->corank;
+	}
       else if (ref->u.ar.type == AR_SECTION)
-	selector->rank = ref->u.ar.dimen;
+	{
+	  selector->rank = ref->u.ar.dimen;
+	  selector->corank = ref->u.ar.codimen;
+	}
       else
 	selector->rank = 0;
 
       rank = selector->rank;
+      corank = selector->corank;
     }
 
   if (rank)
@@ -6400,12 +6408,20 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector,
 	  assoc_sym->as->rank = rank;
 	  assoc_sym->as->type = AS_DEFERRED;
 	}
-      else
-	assoc_sym->as = NULL;
     }
-  else
-    assoc_sym->as = NULL;
 
+  if (corank != 0 && rank == 0)
+    {
+      if (!assoc_sym->as)
+	assoc_sym->as = gfc_get_array_spec ();
+      assoc_sym->as->corank = corank;
+      assoc_sym->attr.codimension = 1;
+    }
+  else if (corank == 0 && rank == 0 && assoc_sym->as)
+    {
+      free (assoc_sym->as);
+      assoc_sym->as = NULL;
+    }
 build_class_sym:
   /* Deal with the very specific case of a SELECT_TYPE selector being an
      associate_name whose type has been identified by component references.
diff --git a/gcc/fortran/matchexp.cc b/gcc/fortran/matchexp.cc
index 3f7140a..9e773cf 100644
--- a/gcc/fortran/matchexp.cc
+++ b/gcc/fortran/matchexp.cc
@@ -133,6 +133,7 @@ gfc_get_parentheses (gfc_expr *e)
   e2 = gfc_get_operator_expr (&e->where, INTRINSIC_PARENTHESES, e, NULL);
   e2->ts = e->ts;
   e2->rank = e->rank;
+  e2->corank = e->corank;
 
   return e2;
 }
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index b28c8a9..a814b79 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5164,7 +5164,7 @@ parse_associate (void)
     {
       gfc_symbol *sym, *tsym;
       gfc_expr *target;
-      int rank;
+      int rank, corank;
 
       if (gfc_get_sym_tree (a->name, NULL, &a->st, false))
 	gcc_unreachable ();
@@ -5225,11 +5225,17 @@ parse_associate (void)
 	  if (sym->ts.type == BT_CLASS)
 	    {
 	      if (CLASS_DATA (sym)->as)
-		target->rank = CLASS_DATA (sym)->as->rank;
+		{
+		  target->rank = CLASS_DATA (sym)->as->rank;
+		  target->corank = CLASS_DATA (sym)->as->corank;
+		}
 	      sym->attr.class_ok = 1;
 	    }
 	  else
-	    target->rank = tsym->result->as ? tsym->result->as->rank : 0;
+	    {
+	      target->rank = tsym->result->as ? tsym->result->as->rank : 0;
+	      target->corank = tsym->result->as ? tsym->result->as->corank : 0;
+	    }
 	}
 
       /* Check if the target expression is array valued. This cannot be done
@@ -5261,18 +5267,19 @@ parse_associate (void)
 	}
 
       rank = target->rank;
+      corank = target->corank;
       /* Fixup cases where the ranks are mismatched.  */
       if (sym->ts.type == BT_CLASS && CLASS_DATA (sym))
 	{
-	  if ((!CLASS_DATA (sym)->as && rank != 0)
-	       || (CLASS_DATA (sym)->as
-		   && CLASS_DATA (sym)->as->rank != rank))
+	  if ((!CLASS_DATA (sym)->as && (rank != 0 || corank != 0))
+	      || (CLASS_DATA (sym)->as
+		  && (CLASS_DATA (sym)->as->rank != rank
+		      || CLASS_DATA (sym)->as->corank != corank)))
 	    {
 	      /* Don't just (re-)set the attr and as in the sym.ts,
 	      because this modifies the target's attr and as.  Copy the
 	      data and do a build_class_symbol.  */
 	      symbol_attribute attr = CLASS_DATA (target)->attr;
-	      int corank = gfc_get_corank (target);
 	      gfc_typespec type;
 
 	      if (rank || corank)
@@ -5290,6 +5297,7 @@ parse_associate (void)
 		  attr.dimension = attr.codimension = 0;
 		}
 	      attr.class_ok = 0;
+	      attr.associate_var = 1;
 	      type = CLASS_DATA (sym)->ts;
 	      if (!gfc_build_class_symbol (&type, &attr, &as))
 		gcc_unreachable ();
@@ -5300,17 +5308,22 @@ parse_associate (void)
 	  else
 	    sym->attr.class_ok = 1;
 	}
-      else if ((!sym->as && rank != 0)
-	       || (sym->as && sym->as->rank != rank))
+      else if ((!sym->as && (rank != 0 || corank != 0))
+	       || (sym->as
+		   && (sym->as->rank != rank || sym->as->corank != corank)))
 	{
 	  as = gfc_get_array_spec ();
 	  as->type = AS_DEFERRED;
 	  as->rank = rank;
-	  as->corank = gfc_get_corank (target);
+	  as->corank = corank;
 	  sym->as = as;
-	  sym->attr.dimension = 1;
-	  if (as->corank)
-	    sym->attr.codimension = 1;
+	  if (rank)
+	    sym->attr.dimension = 1;
+	  if (corank)
+	    {
+	      as->cotype = AS_ASSUMED_SHAPE;
+	      sym->attr.codimension = 1;
+	    }
 	}
     }
 
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 76f6bcb..fb00c08 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -3895,9 +3895,15 @@ gfc_match_rvalue (gfc_expr **result)
 
       if (sym->ts.type == BT_CLASS && sym->attr.class_ok
 	  && CLASS_DATA (sym)->as)
-	e->rank = CLASS_DATA (sym)->as->rank;
+	{
+	  e->rank = CLASS_DATA (sym)->as->rank;
+	  e->corank = CLASS_DATA (sym)->as->corank;
+	}
       else if (sym->as != NULL)
-	e->rank = sym->as->rank;
+	{
+	  e->rank = sym->as->rank;
+	  e->corank = sym->as->corank;
+	}
 
       if (!sym->attr.function
 	  && !gfc_add_function (&sym->attr, sym->name, NULL))
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 8e88aac..ffc3721 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -1439,6 +1439,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
 	      cons->expr->where = para->where;
 	      cons->expr->expr_type = EXPR_ARRAY;
 	      cons->expr->rank = para->rank;
+	      cons->expr->corank = para->corank;
 	      cons->expr->shape = gfc_copy_shape (para->shape, para->rank);
 	      gfc_constructor_append_expr (&cons->expr->value.constructor,
 					   para, &cons->expr->where);
@@ -2180,13 +2181,14 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
 	  || (sym->ts.type == BT_CLASS && sym->attr.class_ok
 	      && CLASS_DATA (sym)->as))
 	{
-	  e->rank = sym->ts.type == BT_CLASS
-		    ? CLASS_DATA (sym)->as->rank : sym->as->rank;
+	  gfc_array_spec *as
+	    = sym->ts.type == BT_CLASS ? CLASS_DATA (sym)->as : 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 = sym->ts.type == BT_CLASS
-			    ? CLASS_DATA (sym)->as : sym->as;
+	  e->ref->u.ar.as = as;
 	}
 
       /* These symbols are set untyped by calls to gfc_set_default_type
@@ -2355,6 +2357,7 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
 	  if (expr)
 	    {
 	      expr->rank = rank;
+	      expr->corank = arg->expr->corank;
 	      if (!expr->shape && arg->expr->shape)
 		{
 		  expr->shape = gfc_get_shape (rank);
@@ -2801,9 +2804,15 @@ resolve_generic_f0 (gfc_expr *expr, gfc_symbol *sym)
 	    expr->ts = s->result->ts;
 
 	  if (s->as != NULL)
-	    expr->rank = s->as->rank;
+	    {
+	      expr->rank = s->as->rank;
+	      expr->corank = s->as->corank;
+	    }
 	  else if (s->result != NULL && s->result->as != NULL)
-	    expr->rank = s->result->as->rank;
+	    {
+	      expr->rank = s->result->as->rank;
+	      expr->corank = s->result->as->corank;
+	    }
 
 	  gfc_set_sym_referenced (expr->value.function.esym);
 
@@ -2943,9 +2952,15 @@ found:
   if (sym->ts.type == BT_CLASS && !CLASS_DATA (sym))
     return MATCH_ERROR;
   if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->as)
-    expr->rank = CLASS_DATA (sym)->as->rank;
+    {
+      expr->rank = CLASS_DATA (sym)->as->rank;
+      expr->corank = CLASS_DATA (sym)->as->corank;
+    }
   else if (sym->as != NULL)
-    expr->rank = sym->as->rank;
+    {
+      expr->rank = sym->as->rank;
+      expr->corank = sym->as->corank;
+    }
 
   return MATCH_YES;
 }
@@ -3066,7 +3081,10 @@ resolve_unknown_f (gfc_expr *expr)
   expr->value.function.esym = expr->symtree->n.sym;
 
   if (sym->as != NULL)
-    expr->rank = sym->as->rank;
+    {
+      expr->rank = sym->as->rank;
+      expr->corank = sym->as->corank;
+    }
 
   /* Type of the expression is either the type of the symbol or the
      default type of the symbol.  */
@@ -4606,6 +4624,33 @@ resolve_operator (gfc_expr *e)
 	    }
 	}
 
+      /* coranks have to be equal or one has to be zero to be combinable.  */
+      if (op1->corank == op2->corank || (op1->corank != 0 && op2->corank == 0))
+	{
+	  e->corank = op1->corank;
+	  /* Only do this, when regular array has not set a shape yet.  */
+	  if (e->shape == NULL)
+	    {
+	      if (op1->corank != 0)
+		{
+		  e->shape = gfc_copy_shape (op1->shape, op1->corank);
+		}
+	    }
+	}
+      else if (op1->corank == 0 && op2->corank != 0)
+	{
+	  e->corank = op2->corank;
+	  /* Only do this, when regular array has not set a shape yet.  */
+	  if (e->shape == NULL)
+	    e->shape = gfc_copy_shape (op2->shape, op2->corank);
+	}
+      else
+	{
+	  gfc_error ("Inconsistent coranks for operator at %%L and %%L",
+		     &op1->where, &op2->where);
+	  return false;
+	}
+
       break;
 
     case INTRINSIC_PARENTHESES:
@@ -4614,6 +4659,7 @@ resolve_operator (gfc_expr *e)
     case INTRINSIC_UMINUS:
       /* Simply copy arrayness attribute */
       e->rank = op1->rank;
+      e->corank = op1->corank;
 
       if (e->shape == NULL)
 	e->shape = gfc_copy_shape (op1->shape, op1->rank);
@@ -5651,8 +5697,8 @@ fail:
 void
 gfc_expression_rank (gfc_expr *e)
 {
-  gfc_ref *ref;
-  int i, rank;
+  gfc_ref *ref, *last_arr_ref = nullptr;
+  int i, rank, corank;
 
   /* Just to make sure, because EXPR_COMPCALL's also have an e->ref and that
      could lead to serious confusion...  */
@@ -5664,22 +5710,42 @@ gfc_expression_rank (gfc_expr *e)
 	goto done;
       /* Constructors can have a rank different from one via RESHAPE().  */
 
-      e->rank = ((e->symtree == NULL || e->symtree->n.sym->as == NULL)
-		 ? 0 : e->symtree->n.sym->as->rank);
+      if (e->symtree != NULL)
+	{
+	  /* After errors the ts.u.derived of a CLASS might not be set.  */
+	  gfc_array_spec *as = (e->symtree->n.sym->ts.type == BT_CLASS
+				&& e->symtree->n.sym->ts.u.derived
+				&& CLASS_DATA (e->symtree->n.sym))
+				 ? CLASS_DATA (e->symtree->n.sym)->as
+				 : e->symtree->n.sym->as;
+	  if (as)
+	    {
+	      e->rank = as->rank;
+	      e->corank = as->corank;
+	      goto done;
+	    }
+	}
+      e->rank = 0;
+      e->corank = 0;
       goto done;
     }
 
   rank = 0;
+  corank = 0;
 
   for (ref = e->ref; ref; ref = ref->next)
     {
       if (ref->type == REF_COMPONENT && ref->u.c.component->attr.proc_pointer
 	  && ref->u.c.component->attr.function && !ref->next)
-	rank = ref->u.c.component->as ? ref->u.c.component->as->rank : 0;
+	{
+	  rank = ref->u.c.component->as ? ref->u.c.component->as->rank : 0;
+	  corank = ref->u.c.component->as ? ref->u.c.component->as->corank : 0;
+	}
 
       if (ref->type != REF_ARRAY)
 	continue;
 
+      last_arr_ref = ref;
       if (ref->u.ar.type == AR_FULL && ref->u.ar.as)
 	{
 	  rank = ref->u.ar.as->rank;
@@ -5700,8 +5766,30 @@ gfc_expression_rank (gfc_expr *e)
 	  break;
 	}
     }
+  if (last_arr_ref && last_arr_ref->u.ar.as)
+    {
+      for (i = last_arr_ref->u.ar.as->rank;
+	   i < last_arr_ref->u.ar.as->rank + last_arr_ref->u.ar.as->corank; ++i)
+	{
+	  /* For unknown dimen in non-resolved as assume full corank.  */
+	  if (last_arr_ref->u.ar.dimen_type[i] == DIMEN_STAR
+	      || (last_arr_ref->u.ar.dimen_type[i] == DIMEN_UNKNOWN
+		  && !last_arr_ref->u.ar.as->resolved))
+	    {
+	      corank = last_arr_ref->u.ar.as->corank;
+	      break;
+	    }
+	  else if (last_arr_ref->u.ar.dimen_type[i] == DIMEN_RANGE
+		   || last_arr_ref->u.ar.dimen_type[i] == DIMEN_VECTOR
+		   || last_arr_ref->u.ar.dimen_type[i] == DIMEN_THIS_IMAGE)
+	    corank++;
+	  else if (last_arr_ref->u.ar.dimen_type[i] != DIMEN_ELEMENT)
+	    gfc_internal_error ("Illegal coarray index");
+	}
+    }
 
   e->rank = rank;
+  e->corank = corank;
 
 done:
   expression_shape (e);
@@ -5719,7 +5807,9 @@ gfc_op_rank_conformable (gfc_expr *op1, gfc_expr *op2)
   if (op2->expr_type == EXPR_VARIABLE)
     gfc_expression_rank (op2);
 
-  return (op1->rank == 0 || op2->rank == 0 || op1->rank == op2->rank);
+  return (op1->rank == 0 || op2->rank == 0 || op1->rank == op2->rank)
+	 && (op1->corank == 0 || op2->corank == 0
+	     || op1->corank == op2->corank);
 }
 
 
@@ -5746,6 +5836,7 @@ add_caf_get_intrinsic (gfc_expr *e)
 				      "caf_get", tmp_expr->where, 1, tmp_expr);
   wrapper->ts = e->ts;
   wrapper->rank = e->rank;
+  wrapper->corank = e->corank;
   if (e->rank)
     wrapper->shape = gfc_copy_shape (e->shape, e->rank);
   *e = *wrapper;
@@ -5926,7 +6017,8 @@ resolve_variable (gfc_expr *e)
     {
       if (sym->ts.type == BT_CLASS)
 	gfc_fix_class_refs (e);
-      if (!sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY)
+      if (!sym->attr.dimension && !sym->attr.codimension && e->ref
+	  && e->ref->type == REF_ARRAY)
 	{
 	  /* Unambiguously scalar!  */
 	  if (sym->assoc->target
@@ -5936,7 +6028,8 @@ resolve_variable (gfc_expr *e)
 		       sym->name, &e->where);
 	  return false;
 	}
-      else if (sym->attr.dimension && (!e->ref || e->ref->type != REF_ARRAY))
+      else if ((sym->attr.dimension || sym->attr.codimension)
+	       && (!e->ref || e->ref->type != REF_ARRAY))
 	{
 	  /* This can happen because the parser did not detect that the
 	     associate name is an array and the expression had no array
@@ -5951,7 +6044,6 @@ resolve_variable (gfc_expr *e)
 	    }
 	  ref->next = e->ref;
 	  e->ref = ref;
-
 	}
     }
 
@@ -5960,7 +6052,7 @@ resolve_variable (gfc_expr *e)
 
   /* On the other hand, the parser may not have known this is an array;
      in this case, we have to add a FULL reference.  */
-  if (sym->assoc && sym->attr.dimension && !e->ref)
+  if (sym->assoc && (sym->attr.dimension || sym->attr.codimension) && !e->ref)
     {
       e->ref = gfc_get_ref ();
       e->ref->type = REF_ARRAY;
@@ -5973,7 +6065,8 @@ resolve_variable (gfc_expr *e)
      the full array ref to _vptr or _len refs.  */
   if (sym->assoc && sym->ts.type == BT_CLASS && sym->ts.u.derived
       && CLASS_DATA (sym)
-      && CLASS_DATA (sym)->attr.dimension
+      && (CLASS_DATA (sym)->attr.dimension
+	  || CLASS_DATA (sym)->attr.codimension)
       && (e->ts.type != BT_DERIVED || !e->ts.u.derived->attr.vtype))
     {
       gfc_ref *ref, *newref;
@@ -6219,6 +6312,7 @@ gfc_fixup_inferred_type_refs (gfc_expr *e)
   if (sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
     {
       sym->attr.dimension = sym->assoc->target->rank ? 1 : 0;
+      sym->attr.codimension = sym->assoc->target->corank ? 1 : 0;
       if (!sym->attr.dimension && e->ref->type == REF_ARRAY)
 	{
 	  ref = e->ref;
@@ -6282,8 +6376,11 @@ gfc_fixup_inferred_type_refs (gfc_expr *e)
       && sym->assoc->target->ts.type == BT_CLASS)
     {
       e->rank = CLASS_DATA (sym)->as ? CLASS_DATA (sym)->as->rank : 0;
+      e->corank = CLASS_DATA (sym)->as ? CLASS_DATA (sym)->as->corank : 0;
       sym->attr.dimension = 0;
+      sym->attr.codimension = 0;
       CLASS_DATA (sym)->attr.dimension = e->rank ? 1 : 0;
+      CLASS_DATA (sym)->attr.codimension = e->corank ? 1 : 0;
       if (e->ref && (e->ref->type != REF_COMPONENT
 		     || e->ref->u.c.component->name[0] != '_'))
 	{
@@ -6463,6 +6560,7 @@ check_host_association (gfc_expr *e)
 	      gfc_free_ref_list (e->ref);
 	      e->ref = NULL;
 	      e->rank = sym->as ? sym->as->rank : 0;
+	      e->corank = sym->as ? sym->as->corank : 0;
 	    }
 
 	  gfc_resolve_expr (e);
@@ -7085,7 +7183,10 @@ resolve_compcall (gfc_expr* e, const char **name)
 
   /* Take the rank from the function's symbol.  */
   if (e->value.compcall.tbp->u.specific->n.sym->as)
-    e->rank = e->value.compcall.tbp->u.specific->n.sym->as->rank;
+    {
+      e->rank = e->value.compcall.tbp->u.specific->n.sym->as->rank;
+      e->corank = e->value.compcall.tbp->u.specific->n.sym->as->corank;
+    }
 
   /* For now, we simply transform it into an EXPR_FUNCTION call with the same
      arglist to the TBP's binding target.  */
@@ -7410,7 +7511,10 @@ resolve_expr_ppc (gfc_expr* e)
   e->value.function.actual = e->value.compcall.actual;
   e->ts = comp->ts;
   if (comp->as != NULL)
-    e->rank = comp->as->rank;
+    {
+      e->rank = comp->as->rank;
+      e->corank = comp->as->corank;
+    }
 
   if (!comp->attr.function)
     gfc_add_function (&comp->attr, comp->name, &e->where);
@@ -9482,8 +9586,8 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 	    sym->as = gfc_copy_array_spec (CLASS_DATA (target)->as);
 	  attr = CLASS_DATA (sym) ? CLASS_DATA (sym)->attr : sym->attr;
 	  sym->attr.dimension = target->rank ? 1 : 0;
-	  gfc_change_class (&sym->ts, &attr, sym->as,
-			    target->rank, gfc_get_corank (target));
+	  gfc_change_class (&sym->ts, &attr, sym->as, target->rank,
+			    target->corank);
 	  sym->as = NULL;
 	}
       else if (target->ts.type == BT_DERIVED
@@ -9500,8 +9604,8 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 	  sym->ts = target->ts;
 	  attr = CLASS_DATA (sym) ? CLASS_DATA (sym)->attr : sym->attr;
 	  sym->attr.dimension = target->rank ? 1 : 0;
-	  gfc_change_class (&sym->ts, &attr, sym->as,
-			    target->rank, gfc_get_corank (target));
+	  gfc_change_class (&sym->ts, &attr, sym->as, target->rank,
+			    target->corank);
 	  sym->as = NULL;
 	  target->ts = sym->ts;
 	}
@@ -9555,6 +9659,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 	       && CLASS_DATA (target)->as)
 	{
 	  target->rank = CLASS_DATA (target)->as->rank;
+	  target->corank = CLASS_DATA (target)->as->corank;
 	  if (!(sym->ts.type == BT_CLASS && CLASS_DATA (sym)->as))
 	    {
 	      sym->ts = target->ts;
@@ -9598,32 +9703,35 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
   if (target->ts.type == BT_CLASS)
     gfc_fix_class_refs (target);
 
-  if (target->rank != 0 && !sym->attr.select_rank_temporary)
+  if ((target->rank != 0 || target->corank != 0)
+      && !sym->attr.select_rank_temporary)
     {
       gfc_array_spec *as;
       /* The rank may be incorrectly guessed at parsing, therefore make sure
 	 it is corrected now.  */
-      if (sym->ts.type != BT_CLASS && !sym->as)
+      if (sym->ts.type != BT_CLASS
+	  && (!sym->as || sym->as->corank != target->corank))
 	{
 	  if (!sym->as)
 	    sym->as = gfc_get_array_spec ();
 	  as = sym->as;
 	  as->rank = target->rank;
 	  as->type = AS_DEFERRED;
-	  as->corank = gfc_get_corank (target);
+	  as->corank = target->corank;
 	  sym->attr.dimension = 1;
 	  if (as->corank != 0)
 	    sym->attr.codimension = 1;
 	}
-      else if (sym->ts.type == BT_CLASS
-	       && CLASS_DATA (sym) && !CLASS_DATA (sym)->as)
+      else if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+	       && (!CLASS_DATA (sym)->as
+		   || CLASS_DATA (sym)->as->corank != target->corank))
 	{
 	  if (!CLASS_DATA (sym)->as)
 	    CLASS_DATA (sym)->as = gfc_get_array_spec ();
 	  as = CLASS_DATA (sym)->as;
 	  as->rank = target->rank;
 	  as->type = AS_DEFERRED;
-	  as->corank = gfc_get_corank (target);
+	  as->corank = target->corank;
 	  CLASS_DATA (sym)->attr.dimension = 1;
 	  if (as->corank != 0)
 	    CLASS_DATA (sym)->attr.codimension = 1;
@@ -9733,8 +9841,8 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
    This is corrected here as well.*/
 
 static void
-fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2,
-		 int rank, gfc_ref *ref)
+fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2, int rank, int corank,
+		 gfc_ref *ref)
 {
   gfc_ref *nref = (*expr1)->ref;
   gfc_symbol *sym1 = (*expr1)->symtree->n.sym;
@@ -9742,6 +9850,7 @@ fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2,
   gfc_expr *selector = gfc_copy_expr (expr2);
 
   (*expr1)->rank = rank;
+  (*expr1)->corank = corank;
   if (selector)
     {
       gfc_resolve_expr (selector);
@@ -9762,14 +9871,16 @@ fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2,
       if ((*expr1)->ts.type != BT_CLASS)
 	(*expr1)->ts = sym1->ts;
 
-      CLASS_DATA (sym1)->attr.dimension = 1;
+      CLASS_DATA (sym1)->attr.dimension = rank > 0 ? 1 : 0;
+      CLASS_DATA (sym1)->attr.codimension = corank > 0 ? 1 : 0;
       if (CLASS_DATA (sym1)->as == NULL && sym2)
 	CLASS_DATA (sym1)->as
 		= gfc_copy_array_spec (CLASS_DATA (sym2)->as);
     }
   else
     {
-      sym1->attr.dimension = 1;
+      sym1->attr.dimension = rank > 0 ? 1 : 0;
+      sym1->attr.codimension = corank > 0 ? 1 : 0;
       if (sym1->as == NULL && sym2)
 	sym1->as = gfc_copy_array_spec (sym2->as);
     }
@@ -9782,6 +9893,12 @@ fixup_array_ref (gfc_expr **expr1, gfc_expr *expr2,
     nref->next = gfc_copy_ref (ref);
   else if (ref && !nref)
     (*expr1)->ref = gfc_copy_ref (ref);
+  else if (ref && nref->u.ar.codimen != corank)
+    {
+      for (int i = nref->u.ar.dimen; i < GFC_MAX_DIMENSIONS; ++i)
+	nref->u.ar.dimen_type[i] = DIMEN_THIS_IMAGE;
+      nref->u.ar.codimen = corank;
+    }
 }
 
 
@@ -9818,11 +9935,16 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
   char name[GFC_MAX_SYMBOL_LEN + 12 + 1];
   gfc_namespace *ns;
   int error = 0;
-  int rank = 0;
+  int rank = 0, corank = 0;
   gfc_ref* ref = NULL;
   gfc_expr *selector_expr = NULL;
 
   ns = code->ext.block.ns;
+  if (code->expr2)
+    {
+      /* Set this, or coarray checks in resolve will fail.  */
+      code->expr1->symtree->n.sym->attr.select_type_temporary = 1;
+    }
   gfc_resolve (ns);
 
   /* Check for F03:C813.  */
@@ -9834,7 +9956,10 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
       return;
     }
 
-  if (!code->expr1->symtree->n.sym->attr.class_ok)
+  /* Prevent segfault, when class type is not initialized due to previous
+     error.  */
+  if (!code->expr1->symtree->n.sym->attr.class_ok
+      || (code->expr1->ts.type == BT_CLASS && !code->expr1->ts.u.derived))
     return;
 
   if (code->expr2)
@@ -9865,10 +9990,12 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 	    ? CLASS_DATA (code->expr2)->ts.u.derived : code->expr2->ts.u.derived;
 	}
 
-      if (code->expr2->rank
-	  && code->expr1->ts.type == BT_CLASS
-	  && CLASS_DATA (code->expr1)->as)
-	CLASS_DATA (code->expr1)->as->rank = code->expr2->rank;
+      if (code->expr1->ts.type == BT_CLASS && CLASS_DATA (code->expr1)->as)
+	{
+	  CLASS_DATA (code->expr1)->as->rank = code->expr2->rank;
+	  CLASS_DATA (code->expr1)->as->corank = code->expr2->corank;
+	  CLASS_DATA (code->expr1)->as->cotype = AS_DEFERRED;
+	}
 
       /* F2008: C803 The selector expression must not be coindexed.  */
       if (gfc_is_coindexed (code->expr2))
@@ -10005,9 +10132,10 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 
   /* Ensure that the selector rank and arrayspec are available to
      correct expressions in which they might be missing.  */
-  if (code->expr2 && code->expr2->rank)
+  if (code->expr2 && (code->expr2->rank || code->expr2->corank))
     {
       rank = code->expr2->rank;
+      corank = code->expr2->corank;
       for (ref = code->expr2->ref; ref; ref = ref->next)
 	if (ref->next == NULL)
 	  break;
@@ -10015,12 +10143,13 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 	ref = gfc_copy_ref (ref);
 
       /* Fixup expr1 if necessary.  */
-      if (rank)
-	fixup_array_ref (&code->expr1, code->expr2, rank, ref);
+      if (rank || corank)
+	fixup_array_ref (&code->expr1, code->expr2, rank, corank, ref);
     }
-  else if (code->expr1->rank)
+  else if (code->expr1->rank || code->expr1->corank)
     {
       rank = code->expr1->rank;
+      corank = code->expr1->corank;
       for (ref = code->expr1->ref; ref; ref = ref->next)
 	if (ref->next == NULL)
 	  break;
@@ -10047,6 +10176,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
      expression has to be set to zero.  */
   gfc_add_vptr_component (code->expr1);
   code->expr1->rank = 0;
+  code->expr1->corank = 0;
   code->expr1 = build_loc_call (code->expr1);
   selector_expr = code->expr1->value.function.actual->expr;
 
@@ -10121,8 +10251,9 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 	{
 	  gfc_add_data_component (st->n.sym->assoc->target);
 	  /* Fixup the target expression if necessary.  */
-	  if (rank)
-	    fixup_array_ref (&st->n.sym->assoc->target, NULL, rank, ref);
+	  if (rank || corank)
+	    fixup_array_ref (&st->n.sym->assoc->target, nullptr, rank, corank,
+			     ref);
 	}
 
       new_st = gfc_get_code (EXEC_BLOCK);
@@ -11757,6 +11888,7 @@ add_comp_ref (gfc_expr *e, gfc_component *c)
     {
       gfc_add_full_array_ref (e, c->as);
       e->rank = c->as->rank;
+      e->corank = c->as->corank;
     }
 }
 
@@ -11851,15 +11983,17 @@ get_temp_from_expr (gfc_expr *e, gfc_namespace *ns)
       if (as->type == AS_DEFERRED)
 	tmp->n.sym->attr.allocatable = 1;
     }
-  else if (e->rank && (e->expr_type == EXPR_ARRAY
-		       || e->expr_type == EXPR_FUNCTION
-		       || e->expr_type == EXPR_OP))
+  else if ((e->rank || e->corank)
+	   && (e->expr_type == EXPR_ARRAY || e->expr_type == EXPR_FUNCTION
+	       || e->expr_type == EXPR_OP))
     {
       tmp->n.sym->as = gfc_get_array_spec ();
       tmp->n.sym->as->type = AS_DEFERRED;
       tmp->n.sym->as->rank = e->rank;
+      tmp->n.sym->as->corank = e->corank;
       tmp->n.sym->attr.allocatable = 1;
-      tmp->n.sym->attr.dimension = 1;
+      tmp->n.sym->attr.dimension = e->rank ? 1 : 0;
+      tmp->n.sym->attr.codimension = e->corank ? 1 : 0;
     }
   else
     tmp->n.sym->attr.dimension = 0;
@@ -13656,7 +13790,9 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
       /* Assume that use associated symbols were checked in the module ns.
 	 Class-variables that are associate-names are also something special
 	 and excepted from the test.  */
-      if (!sym->attr.class_ok && !sym->attr.use_assoc && !sym->assoc)
+      if (!sym->attr.class_ok && !sym->attr.use_assoc && !sym->assoc
+	  && !sym->attr.select_type_temporary
+	  && !sym->attr.select_rank_temporary)
 	{
 	  gfc_error ("CLASS variable %qs at %L must be dummy, allocatable "
 		     "or pointer", sym->name, &sym->declared_at);
@@ -16441,6 +16577,7 @@ resolve_symbol (gfc_symbol *sym)
 		  sym->ts = sym->result->ts;
 		  sym->as = gfc_copy_array_spec (sym->result->as);
 		  sym->attr.dimension = sym->result->attr.dimension;
+		  sym->attr.codimension = sym->result->attr.codimension;
 		  sym->attr.pointer = sym->result->attr.pointer;
 		  sym->attr.allocatable = sym->result->attr.allocatable;
 		  sym->attr.contiguous = sym->result->attr.contiguous;
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index a8b623d..dd209a2 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5410,7 +5410,8 @@ gfc_is_associate_pointer (gfc_symbol* sym)
   if (!sym->assoc->variable)
     return false;
 
-  if (sym->attr.dimension && sym->as->type != AS_EXPLICIT)
+  if ((sym->attr.dimension || sym->attr.codimension)
+      && sym->as->type != AS_EXPLICIT)
     return false;
 
   return true;
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9fb0b2b..ea5fff2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7882,8 +7882,6 @@ walk_coarray (gfc_expr *e)
 {
   gfc_ss *ss;
 
-  gcc_assert (gfc_get_corank (e) > 0);
-
   ss = gfc_walk_expr (e);
 
   /* Fix scalar coarray.  */
@@ -7904,7 +7902,7 @@ walk_coarray (gfc_expr *e)
       gcc_assert (ref != NULL);
       if (ref->u.ar.type == AR_ELEMENT)
 	ref->u.ar.type = AR_SECTION;
-      ss = gfc_reverse_ss (gfc_walk_array_ref (ss, e, ref));
+      ss = gfc_reverse_ss (gfc_walk_array_ref (ss, e, ref, false));
     }
 
   return ss;
@@ -8005,7 +8003,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   bool substr = false;
   gfc_expr *arg, *ss_expr;
 
-  if (se->want_coarray)
+  if (se->want_coarray || expr->rank == 0)
     ss = walk_coarray (expr);
   else
     ss = gfc_walk_expr (expr);
@@ -8338,7 +8336,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	{
 	  gfc_array_ref *ar = &info->ref->u.ar;
 
-	  codim = gfc_get_corank (expr);
+	  codim = expr->corank;
 	  for (n = 0; n < codim - 1; n++)
 	    {
 	      /* Make sure we are not lost somehow.  */
@@ -8488,6 +8486,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 
       /* The 1st element in the section.  */
       base = gfc_index_zero_node;
+      if (expr->ts.type == BT_CHARACTER && expr->rank == 0 && codim)
+	base = gfc_index_one_node;
 
       /* The offset from the 1st element in the section.  */
       offset = gfc_index_zero_node;
@@ -8587,6 +8587,23 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 
       gfc_conv_descriptor_offset_set (&loop.pre, parm, offset);
 
+      if (flag_coarray == GFC_FCOARRAY_LIB && expr->corank)
+	{
+	  tmp = INDIRECT_REF_P (desc) ? TREE_OPERAND (desc, 0) : desc;
+	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+	    {
+	      tmp = gfc_conv_descriptor_token (tmp);
+	    }
+	  else if (DECL_P (tmp) && DECL_LANG_SPECIFIC (tmp)
+		   && GFC_DECL_TOKEN (tmp) != NULL_TREE)
+	    tmp = GFC_DECL_TOKEN (tmp);
+	  else
+	    {
+	      tmp = GFC_TYPE_ARRAY_CAF_TOKEN (TREE_TYPE (tmp));
+	    }
+
+	  gfc_add_modify (&loop.pre, gfc_conv_descriptor_token (parm), tmp);
+	}
       desc = parm;
     }
 
@@ -12110,9 +12127,8 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
   return gfc_walk_array_ref (ss, expr, ref);
 }
 
-
 gfc_ss *
-gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
+gfc_walk_array_ref (gfc_ss *ss, gfc_expr *expr, gfc_ref *ref, bool array_only)
 {
   gfc_array_ref *ar;
   gfc_ss *newss;
@@ -12128,7 +12144,8 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref)
 	}
 
       /* We're only interested in array sections from now on.  */
-      if (ref->type != REF_ARRAY)
+      if (ref->type != REF_ARRAY
+	  || (array_only && ref->u.ar.as && ref->u.ar.as->rank == 0))
 	continue;
 
       ar = &ref->u.ar;
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 29499a3..ab27f15 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -89,7 +89,8 @@ gfc_ss *gfc_walk_expr (gfc_expr *);
 /* Workhorse for gfc_walk_expr.  */
 gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *);
 /* Workhorse for gfc_walk_variable_expr.  */
-gfc_ss *gfc_walk_array_ref (gfc_ss *, gfc_expr *, gfc_ref * ref);
+gfc_ss *gfc_walk_array_ref (gfc_ss *, gfc_expr *, gfc_ref *ref,
+			    bool = true);
 /* Walk the arguments of an elemental function.  */
 gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *,
 					  gfc_intrinsic_sym *,
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 3677e49..9e4fba6 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -147,7 +147,9 @@ tree
 gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *outerse, gfc_expr *expr)
 {
   gfc_symbol *sym = expr->symtree->n.sym;
-  bool is_coarray = sym->attr.codimension;
+  bool is_coarray = sym->ts.type == BT_CLASS
+		      ? CLASS_DATA (sym)->attr.codimension
+		      : sym->attr.codimension;
   gfc_expr *caf_expr = gfc_copy_expr (expr);
   gfc_ref *ref = caf_expr->ref, *last_caf_ref = NULL;
 
@@ -173,6 +175,9 @@ gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *outerse, gfc_expr *expr)
   gfc_free_ref_list (last_caf_ref->next);
   last_caf_ref->next = NULL;
   caf_expr->rank = comp_ref ? 0 : last_caf_ref->u.c.component->as->rank;
+  caf_expr->corank = last_caf_ref->u.c.component->as
+		       ? last_caf_ref->u.c.component->as->corank
+		       : expr->corank;
   se.want_pointer = comp_ref;
   gfc_conv_expr (&se, caf_expr);
   gfc_add_block_to_block (&outerse->pre, &se.pre);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 84a378e..8e1a2b0 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -2407,7 +2407,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
   /* Coarray-argument version: THIS_IMAGE(coarray [, dim]).  */
 
   type = gfc_get_int_type (gfc_default_integer_kind);
-  corank = gfc_get_corank (expr->value.function.actual->expr);
+  corank = expr->value.function.actual->expr->corank;
   rank = expr->value.function.actual->expr->rank;
 
   /* Obtain the descriptor of the COARRAY.  */
@@ -2684,7 +2684,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
   int rank, corank, codim;
 
   type = gfc_get_int_type (gfc_default_integer_kind);
-  corank = gfc_get_corank (expr->value.function.actual->expr);
+  corank = expr->value.function.actual->expr->corank;
   rank = expr->value.function.actual->expr->rank;
 
   /* Obtain the descriptor of the COARRAY.  */
@@ -3162,7 +3162,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
   arg2 = arg->next;
 
   gcc_assert (arg->expr->expr_type == EXPR_VARIABLE);
-  corank = gfc_get_corank (arg->expr);
+  corank = arg->expr->corank;
 
   gfc_init_se (&argse, NULL);
   argse.want_coarray = 1;
@@ -11723,13 +11723,13 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
 					     expr->value.function.isym,
 					     GFC_SS_SCALAR);
 
-  if (expr->rank == 0)
+  if (expr->rank == 0 && expr->corank == 0)
     return ss;
 
   if (gfc_inline_intrinsic_function_p (expr))
     return walk_inline_intrinsic_function (ss, expr);
 
-  if (gfc_is_intrinsic_libcall (expr))
+  if (expr->rank != 0 && gfc_is_intrinsic_libcall (expr))
     return gfc_walk_intrinsic_libfunc (ss, expr);
 
   /* Special cases.  */
@@ -12746,7 +12746,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
   gfc_init_se (&to_se, NULL);
 
   gcc_assert (from_expr->ts.type != BT_CLASS || to_expr->ts.type == BT_CLASS);
-  coarray = gfc_get_corank (from_expr) != 0;
+  coarray = from_expr->corank != 0;
 
   from_is_class = from_expr->ts.type == BT_CLASS;
   from_is_scalar = from_expr->rank == 0 && !coarray;
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 41740ab..807fa8c 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -922,8 +922,8 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
       if (gfc_expr_attr (code->expr1).dimension)
 	{
 	  tree desc, tmp, extent, lbound, ubound;
-          gfc_array_ref *ar, ar2;
-          int i;
+	  gfc_array_ref *ar, ar2;
+	  int i, rank;
 
 	  /* TODO: Extend this, once DT components are supported.  */
 	  ar = &code->expr1->ref->u.ar;
@@ -931,6 +931,8 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
 	  memset (ar, '\0', sizeof (*ar));
 	  ar->as = ar2.as;
 	  ar->type = AR_FULL;
+	  rank = code->expr1->rank;
+	  code->expr1->rank = ar->as->rank;
 
 	  gfc_init_se (&argse, NULL);
 	  argse.descriptor_only = 1;
@@ -938,6 +940,7 @@ gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
 	  gfc_add_block_to_block (&se.pre, &argse.pre);
 	  desc = argse.expr;
 	  *ar = ar2;
+	  code->expr1->rank = rank;
 
 	  extent = build_one_cst (gfc_array_index_type);
 	  for (i = 0; i < ar->dimen; i++)
@@ -1740,6 +1743,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
   tree charlen;
   bool need_len_assign;
   bool whole_array = true;
+  bool same_class;
   gfc_ref *ref;
   gfc_symbol *sym2;
 
@@ -1750,13 +1754,14 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 		  && e->ts.type == BT_CLASS
 		  && (gfc_is_class_scalar_expr (e)
 		      || gfc_is_class_array_ref (e, NULL));
+  same_class = e->ts.type == BT_CLASS && sym->ts.type == BT_CLASS
+	       && strcmp (sym->ts.u.derived->name, e->ts.u.derived->name) == 0;
 
   unlimited = UNLIMITED_POLY (e);
 
   for (ref = e->ref; ref; ref = ref->next)
-    if (ref->type == REF_ARRAY
-	&& ref->u.ar.type == AR_FULL
-	&& ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.type == AR_FULL
+	&& ref->u.ar.dimen != 0 && ref->next)
       {
 	whole_array =  false;
 	break;
@@ -1905,7 +1910,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
       gfc_add_init_cleanup (block, gfc_finish_block (&se.pre), tmp);
     }
   /* Now all the other kinds of associate variable.  */
-  else if (sym->attr.dimension && !class_target
+  else if ((sym->attr.dimension || sym->attr.codimension) && !class_target
 	   && (sym->as->type == AS_DEFERRED || sym->assoc->variable))
     {
       gfc_se se;
@@ -1931,6 +1936,9 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 	  GFC_DECL_PTR_ARRAY_P (sym->backend_decl) = 1;
 	}
 
+      if (sym->attr.codimension && !sym->attr.dimension)
+	se.want_coarray = 1;
+
       gfc_conv_expr_descriptor (&se, e);
 
       if (sym->ts.type == BT_CHARACTER
@@ -1994,7 +2002,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 
   /* Temporaries, arising from TYPE IS, just need the descriptor of class
      arrays to be assigned directly.  */
-  else if (class_target && sym->attr.dimension
+  else if (class_target && (sym->attr.dimension || sym->attr.codimension)
 	   && (sym->ts.type == BT_DERIVED || unlimited))
     {
       gfc_se se;
@@ -2023,7 +2031,9 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 			  gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR (tmp)));
 	}
       else
-	gfc_add_modify (&se.pre, sym->backend_decl, se.expr);
+	gfc_add_modify (&se.pre, sym->backend_decl,
+			build1 (VIEW_CONVERT_EXPR,
+				TREE_TYPE (sym->backend_decl), se.expr));
 
       if (unlimited)
 	{
@@ -2043,7 +2053,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
     {
       gfc_se se;
 
-      gcc_assert (!sym->attr.dimension);
+      gcc_assert (!sym->attr.dimension && !sym->attr.codimension);
 
       gfc_init_se (&se, NULL);
 
@@ -2123,6 +2133,14 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 				     e->symtree->name);
 	  need_len_assign = false;
 	}
+      else if (whole_array && (same_class || unlimited)
+	       && e->ts.type == BT_CLASS && CLASS_DATA (e)->attr.codimension)
+	{
+	  gfc_expr *class_e = gfc_find_and_cut_at_last_class_ref (e);
+	  gfc_conv_expr (&se, class_e);
+	  gfc_free_expr (class_e);
+	  need_len_assign = false;
+	}
       else
 	{
 	  /* For BT_CLASS and BT_DERIVED, this boils down to a pointer assign,
@@ -2158,55 +2176,64 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
 	  tree ctree = gfc_get_class_from_expr (se.expr);
 	  tmp = TREE_TYPE (sym->backend_decl);
 
-	  /* F2018:19.5.1.6 "If a selector has the POINTER attribute,
-	     it shall be associated; the associate name is associated
-	     with the target of the pointer and does not have the
-	     POINTER attribute."  */
-	  if (sym->ts.type == BT_CLASS
-	      && e->ts.type == BT_CLASS && e->rank == 0 && ctree
-	      && (!GFC_CLASS_TYPE_P (TREE_TYPE (se.expr))
-		  || CLASS_DATA (e)->attr.class_pointer))
+	  if (sym->ts.type == BT_CLASS && e->ts.type == BT_CLASS)
 	    {
-	      tree stmp;
-	      tree dtmp;
-	      tree ctmp;
+	      /* F2018:19.5.1.6 "If a selector has the POINTER attribute,
+		 it shall be associated; the associate name is associated
+		 with the target of the pointer and does not have the
+		 POINTER attribute."  */
+	      if (e->rank == 0 && ctree
+		  && (!GFC_CLASS_TYPE_P (TREE_TYPE (se.expr))
+		      || CLASS_DATA (e)->attr.class_pointer))
+		{
+		  tree stmp;
+		  tree dtmp;
+		  tree ctmp;
 
-	      ctmp = ctree;
-	      dtmp = TREE_TYPE (TREE_TYPE (sym->backend_decl));
-	      ctree = gfc_create_var (dtmp, "class");
+		  ctmp = ctree;
+		  dtmp = TREE_TYPE (TREE_TYPE (sym->backend_decl));
+		  ctree = gfc_create_var (dtmp, "class");
 
-	      if (IS_INFERRED_TYPE (e)
-		  && !GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)))
-		stmp = se.expr;
-	      else
-		stmp = gfc_class_data_get (ctmp);
-
-	      /* Coarray scalar component expressions can emerge from
-		 the front end as array elements of the _data field.  */
-	      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp)))
-		stmp = gfc_conv_descriptor_data_get (stmp);
-
-	      if (!POINTER_TYPE_P (TREE_TYPE (stmp)))
-		stmp = gfc_build_addr_expr (NULL, stmp);
-
-	      dtmp = gfc_class_data_get (ctree);
-	      stmp = fold_convert (TREE_TYPE (dtmp), stmp);
-	      gfc_add_modify (&se.pre, dtmp, stmp);
-	      stmp = gfc_class_vptr_get (ctmp);
-	      dtmp = gfc_class_vptr_get (ctree);
-	      stmp = fold_convert (TREE_TYPE (dtmp), stmp);
-	      gfc_add_modify (&se.pre, dtmp, stmp);
-	      if (UNLIMITED_POLY (sym))
-		{
-		  stmp = gfc_class_len_get (ctmp);
-		  dtmp = gfc_class_len_get (ctree);
+		  if (IS_INFERRED_TYPE (e)
+		      && !GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)))
+		    stmp = se.expr;
+		  else
+		    stmp = gfc_class_data_get (ctmp);
+
+		  /* Coarray scalar component expressions can emerge from
+		     the front end as array elements of the _data field.  */
+		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp)))
+		    stmp = gfc_conv_descriptor_data_get (stmp);
+
+		  if (!POINTER_TYPE_P (TREE_TYPE (stmp)))
+		    stmp = gfc_build_addr_expr (NULL, stmp);
+
+		  dtmp = gfc_class_data_get (ctree);
+		  stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+		  gfc_add_modify (&se.pre, dtmp, stmp);
+		  stmp = gfc_class_vptr_get (ctmp);
+		  dtmp = gfc_class_vptr_get (ctree);
 		  stmp = fold_convert (TREE_TYPE (dtmp), stmp);
 		  gfc_add_modify (&se.pre, dtmp, stmp);
-		  need_len_assign = false;
+		  if (UNLIMITED_POLY (sym))
+		    {
+		      stmp = gfc_class_len_get (ctmp);
+		      dtmp = gfc_class_len_get (ctree);
+		      stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+		      gfc_add_modify (&se.pre, dtmp, stmp);
+		      need_len_assign = false;
+		    }
+		  se.expr = ctree;
+		}
+	      else if (CLASS_DATA (sym)->attr.codimension)
+		{
+		  gfc_conv_class_to_class (&se, e, sym->ts, false, false, false,
+					   false);
+		  tmp = se.expr;
 		}
-	      se.expr = ctree;
 	    }
-	  tmp = gfc_build_addr_expr (tmp, se.expr);
+	  if (!POINTER_TYPE_P (TREE_TYPE (se.expr)))
+	    tmp = gfc_build_addr_expr (tmp, se.expr);
 	}
 
       gfc_add_modify (&se.pre, sym->backend_decl, tmp);
@@ -6708,6 +6735,7 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
 	  newsym->n.sym->backend_decl = expr3;
 	  e3rhs = gfc_get_expr ();
 	  e3rhs->rank = code->expr3->rank;
+	  e3rhs->corank = code->expr3->corank;
 	  e3rhs->symtree = newsym;
 	  /* Mark the symbol referenced or gfc_trans_assignment will bug.  */
 	  newsym->n.sym->attr.referenced = 1;
@@ -6733,9 +6761,10 @@ gfc_trans_allocate (gfc_code * code, gfc_omp_namelist *omp_allocate)
 	      gfc_array_spec *arr;
 	      arr = gfc_get_array_spec ();
 	      arr->rank = e3rhs->rank;
+	      arr->corank = e3rhs->corank;
 	      arr->type = AS_DEFERRED;
 	      /* Set the dimension and pointer attribute for arrays
-	     to be on the safe side.  */
+		 to be on the safe side.  */
 	      newsym->n.sym->attr.dimension = 1;
 	      newsym->n.sym->attr.pointer = 1;
 	      newsym->n.sym->as = arr;
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index d4c5409..ce46185 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1404,11 +1404,12 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2,
          ref->next = NULL;
        }
 
-  if (expr->ts.type == BT_CLASS
-      && !expr2->rank
-      && !expr2->ref
-      && CLASS_DATA (expr2->symtree->n.sym)->as)
-    expr->rank = CLASS_DATA (expr2->symtree->n.sym)->as->rank;
+  if (expr->ts.type == BT_CLASS && (!expr2->rank || !expr2->corank)
+      && !expr2->ref && CLASS_DATA (expr2->symtree->n.sym)->as)
+    {
+      expr->rank = CLASS_DATA (expr2->symtree->n.sym)->as->rank;
+      expr->corank = CLASS_DATA (expr2->symtree->n.sym)->as->corank;
+    }
 
   stmtblock_t tmp_block;
   gfc_start_block (&tmp_block);