re PR fortran/34681 (SAVEd derived type with allocatable components causes ICE)

2008-01-08  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34681
	* trans_array.c (gfc_trans_deferred_array): Do not null the
	data pointer on entering scope, nor deallocate it on leaving
	scope, if the symbol has the 'save' attribute.

	PR fortran/34704
	* trans_decl.c (gfc_finish_var_decl): Derived types with
	allocatable components and an initializer must be TREE_STATIC.

2008-01-08  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34681
	PR fortran/34704
	* gfortran.dg/alloc_comp_default_init_1.f90: New test.

From-SVN: r131395
This commit is contained in:
Paul Thomas 2008-01-08 15:12:34 +00:00
parent 8bce96f5a0
commit 3672065a1d
5 changed files with 106 additions and 2 deletions

View File

@ -1,3 +1,14 @@
2008-01-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/34681
* trans_array.c (gfc_trans_deferred_array): Do not null the
data pointer on entering scope, nor deallocate it on leaving
scope, if the symbol has the 'save' attribute.
PR fortran/34704
* trans_decl.c (gfc_finish_var_decl): Derived types with
allocatable components and an initializer must be TREE_STATIC.
2008-01-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/34672

View File

@ -5527,7 +5527,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
}
/* NULLIFY the data pointer. */
if (GFC_DESCRIPTOR_TYPE_P (type))
if (GFC_DESCRIPTOR_TYPE_P (type) && !sym->attr.save)
gfc_conv_descriptor_data_set (&fnblock, descriptor, null_pointer_node);
gfc_add_expr_to_block (&fnblock, body);
@ -5545,7 +5545,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
gfc_add_expr_to_block (&fnblock, tmp);
}
if (sym->attr.allocatable)
if (sym->attr.allocatable && !sym->attr.save)
{
tmp = gfc_trans_dealloc_allocated (sym->backend_decl);
gfc_add_expr_to_block (&fnblock, tmp);

View File

@ -525,6 +525,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
SAVE_EXPLICIT. */
if (!sym->attr.use_assoc
&& (sym->attr.save != SAVE_NONE || sym->attr.data
|| (sym->ts.type == BT_DERIVED
&& sym->ts.derived->attr.alloc_comp
&& sym->value)
|| (sym->value && sym->ns->proc_name->attr.is_main_program)))
TREE_STATIC (decl) = 1;

View File

@ -1,3 +1,9 @@
2008-01-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/34681
PR fortran/34704
* gfortran.dg/alloc_comp_default_init_1.f90: New test.
2008-01-07 Janis Johnson <janis187@us.ibm.com>
* lib/target-supports.exp (check_effective_target_powerpc_spu): New.

View File

@ -0,0 +1,84 @@
! { dg-do run }
! Checks the fixes for PR34681 and PR34704, in which various mixtures
! of default initializer and allocatable array were not being handled
! correctly for derived types with allocatable components.
!
! Contributed by Paolo Giannozzi <p.giannozzi@fisica.uniud.it>
!
program boh
integer :: c1, c2, c3, c4, c5
!
call mah (0, c1) ! These calls deal with PR34681
call mah (1, c2)
call mah (2, c3)
!
if (c1 /= c2) call abort
if (c1 /= c3) call abort
!
call mah0 (c4) ! These calls deal with PR34704
call mah1 (c5)
!
if (c4 /= c5) call abort
!
end program boh
!
subroutine mah (i, c)
!
integer, intent(in) :: i
integer, intent(OUT) :: c
!
type mix_type
real(8), allocatable :: a(:)
complex(8), allocatable :: b(:)
end type mix_type
type(mix_type), allocatable, save :: t(:)
integer :: j, n=1024
!
if (i==0) then
allocate (t(1))
allocate (t(1)%a(n))
allocate (t(1)%b(n))
do j=1,n
t(1)%a(j) = j
t(1)%b(j) = n-j
end do
end if
c = sum( t(1)%a(:) ) + sum( t(1)%b(:) )
if ( i==2) then
deallocate (t(1)%b)
deallocate (t(1)%a)
deallocate (t)
end if
end subroutine mah
subroutine mah0 (c)
!
integer, intent(OUT) :: c
type mix_type
real(8), allocatable :: a(:)
integer :: n=1023
end type mix_type
type(mix_type) :: t
!
allocate(t%a(1))
t%a=3.1415926
c = t%n
deallocate(t%a)
!
end subroutine mah0
!
subroutine mah1 (c)
!
integer, intent(OUT) :: c
type mix_type
real(8), allocatable :: a(:)
integer :: n=1023
end type mix_type
type(mix_type), save :: t
!
allocate(t%a(1))
t%a=3.1415926
c = t%n
deallocate(t%a)
!
end subroutine mah1