Commit d3837072 by Paul Thomas

re PR fortran/33554 (Seg.fault: Default initialization of derived type uses uninitialized values)

2007-10-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33554
	* trans-decl.c (init_intent_out_dt): New function.
	(gfc_trans_deferred_vars): Remove the code for default
	initialization of INTENT(OUT) derived types and put it
	in the new function.  Call it earlier than before, so
	that array offsets and lower bounds are available.

2007-10-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/33554
	* gfortran.dg/intent_out_2.f90: New test.

From-SVN: r128950
parent a7ca4d8d
2007-10-02 Paul Thomas <pault@gcc.gnu.org> 2007-10-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33554
* trans-decl.c (init_intent_out_dt): New function.
(gfc_trans_deferred_vars): Remove the code for default
initialization of INTENT(OUT) derived types and put it
in the new function. Call it earlier than before, so
that array offsets and lower bounds are available.
2007-10-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33550 PR fortran/33550
* decl.c (get_proc_name): Return rc if rc is non-zero; ie. if * decl.c (get_proc_name): Return rc if rc is non-zero; ie. if
the name is a reference to an ambiguous symbol. the name is a reference to an ambiguous symbol.
......
...@@ -2558,6 +2558,44 @@ gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body) ...@@ -2558,6 +2558,44 @@ gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body)
} }
/* Initialize INTENT(OUT) derived type dummies. */
static tree
init_intent_out_dt (gfc_symbol * proc_sym, tree body)
{
stmtblock_t fnblock;
gfc_formal_arglist *f;
gfc_expr *tmpe;
tree tmp;
tree present;
gfc_init_block (&fnblock);
for (f = proc_sym->formal; f; f = f->next)
{
if (f->sym && f->sym->attr.intent == INTENT_OUT
&& f->sym->ts.type == BT_DERIVED
&& !f->sym->ts.derived->attr.alloc_comp
&& f->sym->value)
{
gcc_assert (!f->sym->attr.allocatable);
gfc_set_sym_referenced (f->sym);
tmpe = gfc_lval_expr_from_sym (f->sym);
tmp = gfc_trans_assignment (tmpe, f->sym->value, false);
present = gfc_conv_expr_present (f->sym);
tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present,
tmp, build_empty_stmt ());
gfc_add_expr_to_block (&fnblock, tmp);
gfc_free_expr (tmpe);
}
}
gfc_add_expr_to_block (&fnblock, body);
return gfc_finish_block (&fnblock);
}
/* 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.
...@@ -2612,6 +2650,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) ...@@ -2612,6 +2650,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
&& proc_sym->ts.type == BT_COMPLEX); && proc_sym->ts.type == BT_COMPLEX);
} }
/* Initialize the INTENT(OUT) derived type dummy arguments. This
should be done here so that the offsets and lbounds of arrays
are available. */
fnbody = init_intent_out_dt (proc_sym, fnbody);
for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink) for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
{ {
bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED) bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
...@@ -2710,27 +2753,6 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody) ...@@ -2710,27 +2753,6 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
if (TREE_CODE (f->sym->ts.cl->backend_decl) == PARM_DECL) if (TREE_CODE (f->sym->ts.cl->backend_decl) == PARM_DECL)
gfc_trans_vla_type_sizes (f->sym, &body); gfc_trans_vla_type_sizes (f->sym, &body);
} }
/* If an INTENT(OUT) dummy of derived type has a default
initializer, it must be initialized here. */
if (f->sym && f->sym->attr.intent == INTENT_OUT
&& f->sym->ts.type == BT_DERIVED
&& !f->sym->ts.derived->attr.alloc_comp
&& f->sym->value)
{
gfc_expr *tmpe;
tree tmp, present;
gcc_assert (!f->sym->attr.allocatable);
gfc_set_sym_referenced (f->sym);
tmpe = gfc_lval_expr_from_sym (f->sym);
tmp = gfc_trans_assignment (tmpe, f->sym->value, false);
present = gfc_conv_expr_present (f->sym);
tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present,
tmp, build_empty_stmt ());
gfc_add_expr_to_block (&body, tmp);
gfc_free_expr (tmpe);
}
} }
if (gfc_return_by_reference (proc_sym) && proc_sym->ts.type == BT_CHARACTER if (gfc_return_by_reference (proc_sym) && proc_sym->ts.type == BT_CHARACTER
......
2007-10-02 Paul Thomas <pault@gcc.gnu.org> 2007-10-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33554
* gfortran.dg/intent_out_2.f90: New test.
2007-10-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33550 PR fortran/33550
* gfortran.dg/ambiguous_reference_1.f90: New test. * gfortran.dg/ambiguous_reference_1.f90: New test.
! { dg-do -run } ! { dg-do run }
! Tests the fix for PR33554, in which the default initialization ! Tests the fix for PR33554, in which the default initialization
! of temp, in construct_temp, caused a segfault because it was ! of temp, in construct_temp, caused a segfault because it was
! being done before the array offset and lower bound were ! being done before the array offset and lower bound were
......
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