This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Fortran, patch] PR22290 - Initialization of non-static variable and ICE of dummy argument in ASSIGN statement
- From: Feng Wang <wf_cs at yahoo dot com>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Cc: Steven Bosscher <stevenb at suse dot de>
- Date: Tue, 11 Oct 2005 09:03:59 +0800 (CST)
- Subject: [Fortran, patch] PR22290 - Initialization of non-static variable and ICE of dummy argument in ASSIGN statement
:ADDPATCH fortran:
This PR disappeared long time ago. But the initialization of auxiliary
variables is not correct if we assign a label to a non-static variable. And
will cause ICE if we assign to a dummy argument.
Bootstap tested for mainline and gcc4.0 without any regression on i686-linux.
OK for mainline and 4.0?
Best Regards,
Feng Wang
fortran/ChangeLog:
2005-10-11 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.
testsuite/ChangeLog
2005-10-11 Feng Wang <fengwang@nudt.edu.cn>
PR fortran/22290
* gfortran.dg/assign_5.f90: New test.
* gfortran.dg/assign_6.f: New test.
__________________________________
Meet your soulmate!
Yahoo! Asia presents Meetic - where millions of singles gather
http://asia.yahoo.com/meetic
! { 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
Index: trans-decl.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-decl.c,v
retrieving revision 1.70
diff -c -3 -p -r1.70 trans-decl.c
*** trans-decl.c 3 Oct 2005 07:22:18 -0000 1.70
--- trans-decl.c 10 Oct 2005 14:15:51 -0000
*************** gfc_create_string_length (gfc_symbol * s
*** 717,722 ****
--- 717,755 ----
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. Other value is the length of format string
+ and ASSIGN_ADDR is the address of format string. */
+ 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
exist. */
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 774,779 ****
--- 807,816 ----
}
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;
}
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 820,841 ****
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)
{
/* Character variables need special handling. */
--- 857,862 ----
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 860,865 ****
--- 881,891 ----
}
sym->backend_decl = decl;
+ if (sym->attr.assign)
+ {
+ gfc_add_assign_aux_vars (sym);
+ }
+
if (TREE_STATIC (decl) && !sym->attr.use_assoc)
{
/* Add static initializer. */
*************** gfc_trans_auto_character_variable (gfc_s
*** 2094,2105 ****
return gfc_finish_block (&body);
}
/* Generate function entry and exit code, and add it to the function body.
This includes:
Allocation and initialization of array variables.
Allocation of character string variables.
! Initialization and possibly repacking of dummy arrays. */
static tree
gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
--- 2120,2151 ----
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.
This includes:
Allocation and initialization of array variables.
Allocation of character string variables.
! Initialization and possibly repacking of dummy arrays.
! Initialization of ASSIGN statement auxiliary variable. */
static tree
gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
*************** gfc_trans_deferred_vars (gfc_symbol * pr
*** 2200,2205 ****
--- 2246,2258 ----
fnbody = gfc_trans_auto_character_variable (sym, fnbody);
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
gcc_unreachable ();
}
Index: trans-stmt.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-stmt.c,v
retrieving revision 1.42
diff -c -3 -p -r1.42 trans-stmt.c
*** trans-stmt.c 21 Sep 2005 17:05:12 -0000 1.42
--- trans-stmt.c 10 Oct 2005 14:15:56 -0000
*************** gfc_conv_label_variable (gfc_se * se, gf
*** 91,96 ****
--- 91,99 ----
/* Deals with variable in common block. Get the field declaration. */
if (TREE_CODE (se->expr) == COMPONENT_REF)
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. */