Fix failures with -m32 and some memory leaks.

2020-12-23  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/83118
	* trans-array.c (gfc_alloc_allocatable_for_assignment): Make
	sure that class expressions are captured for dummy arguments by
	use of gfc_get_class_from_gfc_expr otherwise the wrong vptr is
	used.
	* trans-expr.c (gfc_get_class_from_gfc_expr): New function.
	(gfc_get_class_from_expr): If a constant expression is
	encountered, return NULL_TREE;
	(gfc_trans_assignment_1): Deallocate rhs allocatable components
	after passing derived type function results to class lhs.
	* trans.h : Add prototype for gfc_get_class_from_gfc_expr.

1 files changed, 37 insertions, 5 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index f66afab..14361a10 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -508,6 +508,25 @@ gfc_reset_len (stmtblock_t *block, gfc_expr *expr)
 }
 
 
+/* Obtain the last class reference in a gfc_expr. Return NULL_TREE if no class
+   reference is found. Note that it is up to the caller to avoid using this
+   for expressions other than variables.  */
+
+tree
+gfc_get_class_from_gfc_expr (gfc_expr *e)
+{
+  gfc_expr *class_expr;
+  gfc_se cse;
+  class_expr = gfc_find_and_cut_at_last_class_ref (e);
+  if (class_expr == NULL)
+    return NULL_TREE;
+  gfc_init_se (&cse, NULL);
+  gfc_conv_expr (&cse, class_expr);
+  gfc_free_expr (class_expr);
+  return cse.expr;
+}
+
+
 /* Obtain the last class reference in an expression.
    Return NULL_TREE if no class reference is found.  */
 
@@ -11297,11 +11316,24 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
   tmp = NULL_TREE;
 
   if (is_poly_assign)
-    tmp = trans_class_assignment (&body, expr1, expr2, &lse, &rse,
-				  use_vptr_copy || (lhs_attr.allocatable
-						     && !lhs_attr.dimension),
-				  !realloc_flag && flag_realloc_lhs
-				  && !lhs_attr.pointer);
+    {
+      tmp = trans_class_assignment (&body, expr1, expr2, &lse, &rse,
+				    use_vptr_copy || (lhs_attr.allocatable
+						      && !lhs_attr.dimension),
+				    !realloc_flag && flag_realloc_lhs
+				    && !lhs_attr.pointer);
+      if (expr2->expr_type == EXPR_FUNCTION
+	  && expr2->ts.type == BT_DERIVED
+	  && expr2->ts.u.derived->attr.alloc_comp)
+	{
+	  tree tmp2 = gfc_deallocate_alloc_comp (expr2->ts.u.derived,
+						 rse.expr, expr2->rank);
+	  if (lss == gfc_ss_terminator)
+	    gfc_add_expr_to_block (&rse.post, tmp2);
+	  else
+	    gfc_add_expr_to_block (&loop.post, tmp2);
+	}
+    }
   else if (flag_coarray == GFC_FCOARRAY_LIB
 	   && lhs_caf_attr.codimension && rhs_caf_attr.codimension
 	   && ((lhs_caf_attr.allocatable && lhs_refs_comp)