Commit 910450c1 by Feng Wang Committed by Feng Wang

re PR fortran/22290 (Optimize Assigned GOTO to cause error with -O1 or higher)


2005-10-25  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/22290
	* trans-decl.c (gfc_add_assign_aux_vars): New function. Add two
	auxiliary variables.
	(gfc_get_symbol_decl): Use it when a variable, including dummy
	argument, is assigned a label.
	(gfc_trans_assign_aux_var): New function. Set initial value of
	the auxiliary variable explicitly.
	(gfc_trans_deferred_vars): Use it.
	* trans-stmt.c (gfc_conv_label_variable): Handle dummy argument.

2005-10-25  Feng Wang  <fengwang@nudt.edu.cn>

	PR fortran/22290
	* gfortran.dg/assign_5.f90: New test.
	* gfortran.dg/assign_6.f: New test.

From-SVN: r105887
parent a2205647
2005-10-25 Feng Wang <fengwang@nudt.edu.cn>
PR fortran/22290
* trans-decl.c (gfc_add_assign_aux_vars): New function. Add two
auxiliary variables.
(gfc_get_symbol_decl): Use it when a variable, including dummy
argument, is assigned a label.
(gfc_trans_assign_aux_var): New function. Set initial value of
the auxiliary variable explicitly.
(gfc_trans_deferred_vars): Use it.
* trans-stmt.c (gfc_conv_label_variable): Handle dummy argument.
2005-10-24 Asher Langton <langton2@llnl.gov> 2005-10-24 Asher Langton <langton2@llnl.gov>
PR fortran/17031 PR fortran/17031
......
...@@ -723,6 +723,39 @@ gfc_create_string_length (gfc_symbol * sym) ...@@ -723,6 +723,39 @@ gfc_create_string_length (gfc_symbol * sym)
return sym->ts.cl->backend_decl; return sym->ts.cl->backend_decl;
} }
/* If a variable is assigned a label, we add another two auxiliary
variables. */
static void
gfc_add_assign_aux_vars (gfc_symbol * sym)
{
tree addr;
tree length;
tree decl;
gcc_assert (sym->backend_decl);
decl = sym->backend_decl;
gfc_allocate_lang_decl (decl);
GFC_DECL_ASSIGN (decl) = 1;
length = build_decl (VAR_DECL, create_tmp_var_name (sym->name),
gfc_charlen_type_node);
addr = build_decl (VAR_DECL, create_tmp_var_name (sym->name),
pvoid_type_node);
gfc_finish_var_decl (length, sym);
gfc_finish_var_decl (addr, sym);
/* STRING_LENGTH is also used as flag. Less than -1 means that
ASSIGN_ADDR can not be used. Equal -1 means that ASSIGN_ADDR is the
target label's address. Otherwise, value is the length of a format string
and ASSIGN_ADDR is its address. */
if (TREE_STATIC (length))
DECL_INITIAL (length) = build_int_cst (NULL_TREE, -2);
else
gfc_defer_symbol_init (sym);
GFC_DECL_STRING_LEN (decl) = length;
GFC_DECL_ASSIGN_ADDR (decl) = addr;
}
/* Return the decl for a gfc_symbol, create it if it doesn't already /* Return the decl for a gfc_symbol, create it if it doesn't already
exist. */ exist. */
...@@ -780,6 +813,10 @@ gfc_get_symbol_decl (gfc_symbol * sym) ...@@ -780,6 +813,10 @@ 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)
{
gfc_add_assign_aux_vars (sym);
}
return sym->backend_decl; return sym->backend_decl;
} }
...@@ -826,22 +863,6 @@ gfc_get_symbol_decl (gfc_symbol * sym) ...@@ -826,22 +863,6 @@ gfc_get_symbol_decl (gfc_symbol * sym)
gfc_finish_var_decl (decl, sym); gfc_finish_var_decl (decl, sym);
if (sym->attr.assign)
{
gfc_allocate_lang_decl (decl);
GFC_DECL_ASSIGN (decl) = 1;
length = gfc_create_var (gfc_charlen_type_node, sym->name);
GFC_DECL_STRING_LEN (decl) = length;
GFC_DECL_ASSIGN_ADDR (decl) = gfc_create_var (pvoid_type_node, sym->name);
/* TODO: Need to check we don't change TREE_STATIC (decl) later. */
TREE_STATIC (length) = TREE_STATIC (decl);
/* STRING_LENGTH is also used as flag. Less than -1 means that
ASSIGN_ADDR can not be used. Equal -1 means that ASSIGN_ADDR is the
target label's address. Other value is the length of format string
and ASSIGN_ADDR is the address of format string. */
DECL_INITIAL (length) = build_int_cst (NULL_TREE, -2);
}
if (sym->ts.type == BT_CHARACTER) if (sym->ts.type == BT_CHARACTER)
{ {
/* Character variables need special handling. */ /* Character variables need special handling. */
...@@ -866,6 +887,11 @@ gfc_get_symbol_decl (gfc_symbol * sym) ...@@ -866,6 +887,11 @@ gfc_get_symbol_decl (gfc_symbol * sym)
} }
sym->backend_decl = decl; sym->backend_decl = decl;
if (sym->attr.assign)
{
gfc_add_assign_aux_vars (sym);
}
if (TREE_STATIC (decl) && !sym->attr.use_assoc) if (TREE_STATIC (decl) && !sym->attr.use_assoc)
{ {
/* Add static initializer. */ /* Add static initializer. */
...@@ -2105,12 +2131,32 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, tree fnbody) ...@@ -2105,12 +2131,32 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, tree fnbody)
return gfc_finish_block (&body); return gfc_finish_block (&body);
} }
/* Set the initial value of ASSIGN statement auxiliary variable explicitly. */
static tree
gfc_trans_assign_aux_var (gfc_symbol * sym, tree fnbody)
{
stmtblock_t body;
gcc_assert (sym->backend_decl);
gfc_start_block (&body);
/* Set the initial value to length. See the comments in
function gfc_add_assign_aux_vars in this file. */
gfc_add_modify_expr (&body, GFC_DECL_STRING_LEN (sym->backend_decl),
build_int_cst (NULL_TREE, -2));
gfc_add_expr_to_block (&body, fnbody);
return gfc_finish_block (&body);
}
/* Generate function entry and exit code, and add it to the function body. /* Generate function entry and exit code, and add it to the function body.
This includes: This includes:
Allocation and initialization of array variables. Allocation and initialization of array variables.
Allocation of character string variables. Allocation of character string variables.
Initialization and possibly repacking of dummy arrays. */ Initialization and possibly repacking of dummy arrays.
Initialization of ASSIGN statement auxiliary variable. */
static tree static tree
gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
...@@ -2211,6 +2257,13 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) ...@@ -2211,6 +2257,13 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
fnbody = gfc_trans_auto_character_variable (sym, fnbody); fnbody = gfc_trans_auto_character_variable (sym, fnbody);
gfc_set_backend_locus (&loc); gfc_set_backend_locus (&loc);
} }
else if (sym->attr.assign)
{
gfc_get_backend_locus (&loc);
gfc_set_backend_locus (&sym->declared_at);
fnbody = gfc_trans_assign_aux_var (sym, fnbody);
gfc_set_backend_locus (&loc);
}
else else
gcc_unreachable (); gcc_unreachable ();
} }
......
...@@ -91,6 +91,9 @@ gfc_conv_label_variable (gfc_se * se, gfc_expr * expr) ...@@ -91,6 +91,9 @@ gfc_conv_label_variable (gfc_se * se, gfc_expr * expr)
/* Deals with variable in common block. Get the field declaration. */ /* Deals with variable in common block. Get the field declaration. */
if (TREE_CODE (se->expr) == COMPONENT_REF) if (TREE_CODE (se->expr) == COMPONENT_REF)
se->expr = TREE_OPERAND (se->expr, 1); se->expr = TREE_OPERAND (se->expr, 1);
/* Deals with dummy argument. Get the parameter declaration. */
else if (TREE_CODE (se->expr) == INDIRECT_REF)
se->expr = TREE_OPERAND (se->expr, 0);
} }
/* Translate a label assignment statement. */ /* Translate a label assignment statement. */
......
2005-10-25 Feng Wang <fengwang@nudt.edu.cn>
PR fortran/22290
* gfortran.dg/assign_5.f90: New test.
* gfortran.dg/assign_6.f: New test.
2005-10-25 Uros Bizjak <uros@kss-loka.si> 2005-10-25 Uros Bizjak <uros@kss-loka.si>
* g++.dg/other/i386-1.C: Include i386-cpuid.h. Pass if * g++.dg/other/i386-1.C: Include i386-cpuid.h. Pass if
! { dg-do run }
! Assign a label to a dummy argument.
! Option passed to avoid excess errors from obsolete warning
! { dg-options "-w" }
subroutine s1 (a)
integer a
assign 777 to a
go to a
777 continue
end
program test
call s1 (1)
end
C { dg-do run }
C Option passed to avoid excess errors from obsolete warning
C { dg-options "-w" }
C PR22290
integer nz
assign 93 to nz
go to nz,(93)
93 continue
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