View | Details | Return to bug 64290 | Differences between
and this patch

Collapse All | Expand All

(-)a/gcc/fortran/trans-expr.c (+35 lines)
Lines 11022-11027 gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, Link Here
11022
  tree tmp;
11022
  tree tmp;
11023
  stmtblock_t block;
11023
  stmtblock_t block;
11024
  stmtblock_t body;
11024
  stmtblock_t body;
11025
  stmtblock_t final_block;
11025
  bool l_is_temp;
11026
  bool l_is_temp;
11026
  bool scalar_to_array;
11027
  bool scalar_to_array;
11027
  tree string_length;
11028
  tree string_length;
Lines 11389-11394 gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, Link Here
11389
11390
11390
  /* Add the pre blocks to the body.  */
11391
  /* Add the pre blocks to the body.  */
11391
  gfc_add_block_to_block (&body, &rse.pre);
11392
  gfc_add_block_to_block (&body, &rse.pre);
11393
11394
  /* F2018 (7.5.6.3): "When an intrinsic assignment statement is executed
11395
     (10.2.1.3), if the variable is not an unallocated allocatable variable,
11396
     it is finalized after evaluation of expr and before the definition of
11397
     the variable. If the variable is an allocated allocatable variable, or
11398
     has an allocated allocatable subobject, that would be deallocated by
11399
     intrinsic assignment, the finalization occurs before the deallocation */
11400
11401
  gfc_init_block (&final_block);
11402
  /* We have to exclude vtable procedures (_copy and _final especially), uses
11403
     of gfc_trans_assignment_1 in initialization and allocation before trying
11404
     to build a final call.  */
11405
  if (!expr1->symtree->n.sym->attr.artificial
11406
      && !expr1->symtree->n.sym->ns->proc_name->attr.artificial
11407
      && !init_flag && !(!dealloc
11408
			 && (gfc_expr_attr (expr1).allocatable
11409
			     || (expr1->ts.type == BT_CLASS
11410
				 && CLASS_DATA (expr1)->attr.allocatable)))
11411
      && gfc_add_finalizer_call (&final_block, expr1))
11412
    {
11413
      tree tmp2 = gfc_finish_block (&final_block);
11414
      if (expr1->symtree->n.sym->attr.optional)
11415
	{
11416
	  tree cond = gfc_conv_expr_present (expr1->symtree->n.sym);
11417
	  tmp2 = build3_loc (input_location, COND_EXPR, void_type_node,
11418
			     cond, tmp2, build_empty_stmt (input_location));
11419
	}
11420
11421
      if (lss == gfc_ss_terminator)
11422
	gfc_add_expr_to_block (&body, tmp2);
11423
      else
11424
	gfc_prepend_expr_to_block (&loop.pre, tmp2);
11425
    }
11426
11392
  gfc_add_block_to_block (&body, &lse.pre);
11427
  gfc_add_block_to_block (&body, &lse.pre);
11393
  gfc_add_expr_to_block (&body, tmp);
11428
  gfc_add_expr_to_block (&body, tmp);
11394
  /* Add the post blocks to the body.  */
11429
  /* Add the post blocks to the body.  */

Return to bug 64290