This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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" } }
+   

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]