diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e7c51bae052..1c2af55d436 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3271,6 +3271,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base)
   gfc_add_block_to_block (block, &se.pre);
   info->descriptor = se.expr;
   ss_info->string_length = se.string_length;
+  ss_info->class_container = se.class_container;
 
   if (base)
     {
@@ -7687,6 +7688,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	  else if (deferred_array_component)
 	    se->string_length = ss_info->string_length;
 
+	  se->class_container = ss_info->class_container;
+
 	  gfc_free_ss_chain (ss);
 	  return;
 	}
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ebef1a36577..01386bceaeb 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -529,24 +529,10 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold,
 }
 
 
-/* Reset the vptr to the declared type, e.g. after deallocation.  */
-
-void
-gfc_reset_vptr (stmtblock_t *block, gfc_expr *e)
+static void
+reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_expr)
 {
-  gfc_symbol *vtab;
-  tree vptr;
-  tree vtable;
-  gfc_se se;
-
-  /* Evaluate the expression and obtain the vptr from it.  */
-  gfc_init_se (&se, NULL);
-  if (e->rank)
-    gfc_conv_expr_descriptor (&se, e);
-  else
-    gfc_conv_expr (&se, e);
-  gfc_add_block_to_block (block, &se.pre);
-  vptr = gfc_get_vptr_from_expr (se.expr);
+  tree vptr = gfc_get_vptr_from_expr (class_expr);
 
   /* If a vptr is not found, we can do nothing more.  */
   if (vptr == NULL_TREE)
@@ -556,6 +542,9 @@ gfc_reset_vptr (stmtblock_t *block, gfc_expr *e)
     gfc_add_modify (block, vptr, build_int_cst (TREE_TYPE (vptr), 0));
   else
     {
+      gfc_symbol *vtab;
+      tree vtable;
+
       /* Return the vptr to the address of the declared type.  */
       vtab = gfc_find_derived_vtab (e->ts.u.derived);
       vtable = vtab->backend_decl;
@@ -568,6 +557,24 @@ gfc_reset_vptr (stmtblock_t *block, gfc_expr *e)
 }
 
 
+/* Reset the vptr to the declared type, e.g. after deallocation.  */
+
+void
+gfc_reset_vptr (stmtblock_t *block, gfc_expr *e)
+{
+  gfc_se se;
+
+  /* Evaluate the expression and obtain the vptr from it.  */
+  gfc_init_se (&se, NULL);
+  if (e->rank)
+    gfc_conv_expr_descriptor (&se, e);
+  else
+    gfc_conv_expr (&se, e);
+  gfc_add_block_to_block (block, &se.pre);
+  reset_vptr (block, e, se.expr);
+}
+
+
 /* Reset the len for unlimited polymorphic objects.  */
 
 void
@@ -1266,6 +1273,8 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
 
       slen = build_zero_cst (size_type_node);
     }
+  else if (parmse->class_container != NULL_TREE)
+    tmp = parmse->class_container;
   else
     {
       /* Remove everything after the last class reference, convert the
@@ -3078,6 +3087,11 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	  return;
 	}
 
+      if (sym->ts.type == BT_CLASS
+	  && sym->attr.class_ok
+	  && sym->ts.u.derived->attr.is_class)
+	se->class_container = se->expr;
+
       /* Dereference the expression, where needed.  */
       se->expr = gfc_maybe_dereference_var (sym, se->expr, se->descriptor_only,
 					    is_classarray);
@@ -3135,6 +3149,15 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	    conv_parent_component_references (se, ref);
 
 	  gfc_conv_component_ref (se, ref);
+
+	  if (ref->u.c.component->ts.type == BT_CLASS
+	      && ref->u.c.component->attr.class_ok
+	      && ref->u.c.component->ts.u.derived->attr.is_class)
+	    se->class_container = se->expr;
+	  else if (!(ref->u.c.sym->attr.flavor == FL_DERIVED
+		     && ref->u.c.sym->attr.is_class))
+	    se->class_container = NULL_TREE;
+		
 	  if (!ref->next && ref->u.c.sym->attr.codimension
 	      && se->want_pointer && se->descriptor_only)
 	    return;
@@ -6784,6 +6807,21 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		  stmtblock_t block;
 		  tree ptr;
 
+		  /* In case the data reference to deallocate is dependent on
+		     its own content, save the resulting pointer to a variable
+		     and only use that variable from now on, before the
+		     expression becomes invalid.  */
+		  tree t = gfc_build_addr_expr (NULL_TREE, parmse.expr);
+		  t = gfc_evaluate_now (t, &parmse.pre);
+		  parmse.expr = build_fold_indirect_ref_loc (input_location, t);
+
+		  if (parmse.class_container != NULL_TREE)
+		    {
+		      t = gfc_build_addr_expr (NULL_TREE, parmse.class_container);
+		      t = gfc_evaluate_now (t, &parmse.pre);
+		      parmse.class_container = build_fold_indirect_ref_loc (input_location, t);
+		    }
+
 		  gfc_init_block  (&block);
 		  ptr = parmse.expr;
 		  ptr = gfc_class_data_get (ptr);
@@ -6797,7 +6835,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 					 void_type_node, ptr,
 					 null_pointer_node);
 		  gfc_add_expr_to_block (&block, tmp);
-		  gfc_reset_vptr (&block, e);
+		  if (parmse.class_container == NULL_TREE)
+		    gfc_reset_vptr (&block, e);
+		  else
+		    reset_vptr (&block, e, parmse.class_container);
 
 		  if (fsym->attr.optional
 		      && e->expr_type == EXPR_VARIABLE
@@ -6819,9 +6860,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		  defer_to_dealloc_blk = true;
 		}
 
+	      gfc_se class_se = parmse;
+	      gfc_init_block (&class_se.pre);
+	      gfc_init_block (&class_se.post);
+
 	      /* The conversion does not repackage the reference to a class
 	         array - _data descriptor.  */
-	      gfc_conv_class_to_class (&parmse, e, fsym->ts, false,
+	      gfc_conv_class_to_class (&class_se, e, fsym->ts, false,
 				     fsym->attr.intent != INTENT_IN
 				     && (CLASS_DATA (fsym)->attr.class_pointer
 					 || CLASS_DATA (fsym)->attr.allocatable),
@@ -6831,9 +6876,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				     CLASS_DATA (fsym)->attr.class_pointer
 				     || CLASS_DATA (fsym)->attr.allocatable);
 
-	      /* Defer repackaging after deallocation.  */
-	      if (defer_to_dealloc_blk)
-		gfc_add_block_to_block (&dealloc_blk, &parmse.pre);
+	      parmse.expr = class_se.expr;
+	      stmtblock_t *class_pre_block = defer_to_dealloc_blk ? &dealloc_blk : &parmse.pre;
+	      gfc_add_block_to_block (class_pre_block, &class_se.pre);
+	      gfc_add_block_to_block (&parmse.post, &class_se.post);
 	    }
 	  else
 	    {
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 0c8d004736d..9254de733de 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -57,6 +57,10 @@ typedef struct gfc_se
      here.  */
   tree class_vptr;
 
+  /* When expr is a reference to class subobject, store the class object
+     here.  */
+  tree class_container;
+
   /* Whether expr is a reference to an unlimited polymorphic object.  */
   unsigned unlimited_polymorphic:1;
 
@@ -263,6 +267,7 @@ typedef struct gfc_ss_info
   gfc_ss_type type;
   gfc_expr *expr;
   tree string_length;
+  tree class_container;
 
   union
   {