This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR31163 - SAVEd derived types with ALLOCATABLE components don't work
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Wed, 14 Mar 2007 07:30:18 +0100
- Subject: [Patch, fortran] PR31163 - SAVEd derived types with ALLOCATABLE components don't work
:ADDPATCH fortran:
This is obvious but I submit it for review anyway:)
Bootstrapped and regtested on amd64/Cygwin_NT - OK for trunk and, when
ready, 4.2?
Paul
PS Note that since Tobias' fix, c_by_val_1.f fails on Cygwin_NT
2007-03-14 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31163
* trans-array.c (parse_interface): Do not nullify allocatable
components if the symbol has the saved attribute.
2007-03-14 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31163
* gfortran.dg/alloc_comp_basics_5.f90: New test.
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 122847)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_trans_deferred_array (gfc_symbol * s
*** 5217,5225 ****
if (sym_has_alloc_comp && !(sym->attr.pointer || sym->attr.allocatable))
{
! rank = sym->as ? sym->as->rank : 0;
! tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank);
! gfc_add_expr_to_block (&fnblock, tmp);
}
else if (!GFC_DESCRIPTOR_TYPE_P (type))
{
--- 5217,5228 ----
if (sym_has_alloc_comp && !(sym->attr.pointer || sym->attr.allocatable))
{
! if (!sym->attr.save)
! {
! rank = sym->as ? sym->as->rank : 0;
! tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank);
! gfc_add_expr_to_block (&fnblock, tmp);
! }
}
else if (!GFC_DESCRIPTOR_TYPE_P (type))
{
*************** gfc_trans_deferred_array (gfc_symbol * s
*** 5240,5246 ****
/* Allocatable arrays need to be freed when they go out of scope.
The allocatable components of pointers must not be touched. */
if (sym_has_alloc_comp && !(sym->attr.function || sym->attr.result)
! && !sym->attr.pointer)
{
int rank;
rank = sym->as ? sym->as->rank : 0;
--- 5243,5249 ----
/* Allocatable arrays need to be freed when they go out of scope.
The allocatable components of pointers must not be touched. */
if (sym_has_alloc_comp && !(sym->attr.function || sym->attr.result)
! && !sym->attr.pointer && !sym->attr.save)
{
int rank;
rank = sym->as ? sym->as->rank : 0;
Index: gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90
===================================================================
*** gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/alloc_comp_basics_5.f90 (revision 0)
***************
*** 0 ****
--- 1,48 ----
+ ! { dg-do run }
+ ! This checks the correct functioning of derived types with the SAVE
+ ! attribute and allocatable components - PR31163
+ !
+ ! Contributed by Salvatore Filippone <salvatore.filippone@uniroma2.it>
+ !
+ Module bar_mod
+
+ type foo_type
+ integer, allocatable :: mv(:)
+ end type foo_type
+
+
+ contains
+
+
+ subroutine bar_foo_ab(info)
+
+ integer, intent(out) :: info
+ Type(foo_type), save :: f_a
+
+ if (allocated(f_a%mv)) then
+ info = size(f_a%mv)
+ else
+ allocate(f_a%mv(10),stat=info)
+ if (info /= 0) then
+ info = -1
+ endif
+ end if
+ end subroutine bar_foo_ab
+
+
+ end module bar_mod
+
+ program tsave
+ use bar_mod
+
+ integer :: info
+
+ call bar_foo_ab(info)
+ if (info .ne. 0) call abort ()
+ call bar_foo_ab(info)
+ if (info .ne. 10) call abort ()
+
+ end program tsave
+
+ ! { dg-final { cleanup-modules "bar_mod" } }
+