Commit 4e2c7f9a by Mark Eggleston

Fortran : ICE in gfc_trans_label_assign PR50392

A function may contain an assigned goto.  If the the return variable
is an integer a statement can be assigned to it.  Prior to this fix
this resulted in an ICE.

2020-05-28  Tobias Burnus  <tobias@codesourcery.com>

gcc/fortran/

	PR fortran/50392
	* trans-decl.c (gfc_get_symbol_decl): Remove unnecessary block
	delimiters.  Add auxiliary variables if a label is assigned to
	a return variable. (gfc_gat_fake_result): If the symbol has an
	assign attribute set declaration from the symbol's backend
	declaration.

2020-05-28  Mark Eggleston  <markeggleston@gnu.gcc.org>

gcc/testsuite/

	PR fortran/50392
	* gfortran.dg/pr50392.f: New test.

(cherry picked from commit a7fd43c38f7469a3ef5ee30e889d60e1376d4dfc)
parent e8c25021
...@@ -1682,9 +1682,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) ...@@ -1682,9 +1682,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
TREE_USED (sym->backend_decl) = 1; TREE_USED (sym->backend_decl) = 1;
if (sym->attr.assign && GFC_DECL_ASSIGN (sym->backend_decl) == 0) if (sym->attr.assign && GFC_DECL_ASSIGN (sym->backend_decl) == 0)
{ gfc_add_assign_aux_vars (sym);
gfc_add_assign_aux_vars (sym);
}
if (sym->ts.type == BT_CLASS && sym->backend_decl) if (sym->ts.type == BT_CLASS && sym->backend_decl)
GFC_DECL_CLASS(sym->backend_decl) = 1; GFC_DECL_CLASS(sym->backend_decl) = 1;
...@@ -1692,6 +1690,10 @@ gfc_get_symbol_decl (gfc_symbol * sym) ...@@ -1692,6 +1690,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
return sym->backend_decl; return sym->backend_decl;
} }
if (sym->result == sym && sym->attr.assign
&& GFC_DECL_ASSIGN (sym->backend_decl) == 0)
gfc_add_assign_aux_vars (sym);
if (sym->backend_decl) if (sym->backend_decl)
return sym->backend_decl; return sym->backend_decl;
...@@ -3196,6 +3198,9 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag) ...@@ -3196,6 +3198,9 @@ gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag)
else else
current_fake_result_decl = build_tree_list (NULL, decl); current_fake_result_decl = build_tree_list (NULL, decl);
if (sym->attr.assign)
DECL_LANG_SPECIFIC (decl) = DECL_LANG_SPECIFIC (sym->backend_decl);
return decl; return decl;
} }
......
! { dg-do compile }
!
function kf()
integer kf
assign 1 to kf ! { dg-warning "Deleted feature: ASSIGN statement at" }
kf = 2
goto kf ! { dg-warning "Deleted feature: Assigned GOTO statement at" }
kf = 1
1 continue
kf = 0
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment