mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 13:41:18 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Paul Thomas 2007-10-02 08:03:07 +00:00
parent a7ca4d8d3d
commit d383707213
4 changed files with 97 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
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

64
gcc/fortran/trans-decl.c
View File

@ -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.
This includes:
Allocation and initialization of array variables.
@ -2612,6 +2650,11 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
&& 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)
{
bool sym_has_alloc_comp = (sym->ts.type == BT_DERIVED)
@ -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)
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

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
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

80
gcc/testsuite/gfortran.dg/intent_out_2.f90
View File

@ -1,47 +1,47 @@
! { dg-do -run }
! { dg-do run }
! Tests the fix for PR33554, in which the default initialization
! of temp, in construct_temp, caused a segfault because it was
! being done before the array offset and lower bound were
! available.
!
! Contributed by Harald Anlauf <anlauf@gmx.de>
!
module gfcbug72
implicit none
type t_datum
character(len=8) :: mn = 'abcdefgh'
end type t_datum
type t_temp
type(t_datum) :: p
end type t_temp
contains
subroutine setup ()
integer :: i
type (t_temp), pointer :: temp(:) => NULL ()
do i=1,2
allocate (temp (2))
call construct_temp (temp)
if (any (temp % p% mn .ne. 'ijklmnop')) call abort ()
deallocate (temp)
end do
end subroutine setup
!--
subroutine construct_temp (temp)
type (t_temp), intent(out) :: temp (:)
if (any (temp % p% mn .ne. 'abcdefgh')) call abort ()
temp(:)% p% mn = 'ijklmnop'
end subroutine construct_temp
end module gfcbug72
program test
use gfcbug72
implicit none
call setup ()
end program test
!
module gfcbug72
implicit none
type t_datum
character(len=8) :: mn = 'abcdefgh'
end type t_datum
type t_temp
type(t_datum) :: p
end type t_temp
contains
subroutine setup ()
integer :: i
type (t_temp), pointer :: temp(:) => NULL ()
do i=1,2
allocate (temp (2))
call construct_temp (temp)
if (any (temp % p% mn .ne. 'ijklmnop')) call abort ()
deallocate (temp)
end do
end subroutine setup
!--
subroutine construct_temp (temp)
type (t_temp), intent(out) :: temp (:)
if (any (temp % p% mn .ne. 'abcdefgh')) call abort ()
temp(:)% p% mn = 'ijklmnop'
end subroutine construct_temp
end module gfcbug72
program test
use gfcbug72
implicit none
call setup ()
end program test
! { dg-final { cleanup-modules "gfcbug72" } }