fix PR 86484 and PR 84543

[gcc.git] / gcc / fortran / trans-stmt.c

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 1952f6cdc0847fb6b945cddb9dab469291187dd3..795d3cc0a13c2033a3ca2e2a5e5eb971179d568d 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1735,11 +1735,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
       if (sym->attr.subref_array_pointer)
        {
          gcc_assert (e->expr_type == EXPR_VARIABLE);
-         tmp = e->symtree->n.sym->ts.type == BT_CLASS
-             ? gfc_class_data_get (e->symtree->n.sym->backend_decl)
-             : e->symtree->n.sym->backend_decl;
-         tmp = gfc_get_element_type (TREE_TYPE (tmp));
-         tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
+         tmp = gfc_get_array_span (se.expr, e);
+
          gfc_conv_descriptor_span_set (&se.pre, desc, tmp);
        }
 
@@ -5786,6 +5783,7 @@ gfc_trans_allocate (gfc_code * code)
   enum { E3_UNSET = 0, E3_SOURCE, E3_MOLD, E3_DESC } e3_is;
   stmtblock_t block;
   stmtblock_t post;
+  stmtblock_t final_block;
   tree nelems;
   bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set, is_coarray;
   bool needs_caf_sync, caf_refs_comp;
@@ -5804,6 +5802,7 @@ gfc_trans_allocate (gfc_code * code)
 
   gfc_init_block (&block);
   gfc_init_block (&post);
+  gfc_init_block (&final_block);
 
   /* STAT= (and maybe ERRMSG=) is present.  */
   if (code->expr1)
@@ -5845,6 +5844,11 @@ gfc_trans_allocate (gfc_code * code)
 
       is_coarray = gfc_is_coarray (code->expr3);
 
+      if (code->expr3->expr_type == EXPR_FUNCTION && !code->expr3->mold
+         && (gfc_is_class_array_function (code->expr3)
+             || gfc_is_alloc_class_scalar_function (code->expr3)))
+       code->expr3->must_finalize = 1;
+
       /* Figure whether we need the vtab from expr3.  */
       for (al = code->ext.alloc.list; !vtab_needed && al != NULL;
           al = al->next)
@@ -5917,7 +5921,10 @@ gfc_trans_allocate (gfc_code * code)
          temp_obj_created = temp_var_needed = !VAR_P (se.expr);
        }
       gfc_add_block_to_block (&block, &se.pre);
-      gfc_add_block_to_block (&post, &se.post);
+      if (code->expr3->must_finalize)
+       gfc_add_block_to_block (&final_block, &se.post);
+      else
+       gfc_add_block_to_block (&post, &se.post);
 
       /* Special case when string in expr3 is zero.  */
       if (code->expr3->ts.type == BT_CHARACTER
@@ -6746,6 +6753,8 @@ gfc_trans_allocate (gfc_code * code)
 
   gfc_add_block_to_block (&block, &se.post);
   gfc_add_block_to_block (&block, &post);
+  if (code->expr3 && code->expr3->must_finalize)
+    gfc_add_block_to_block (&block, &final_block);
 
   return gfc_finish_block (&block);
 }