User account creation filtered due to spam.

Bug 46174

Summary: [OOP] ALLOCATE with SOURCE: Deep copy missing
Product: gcc Reporter: Tobias Burnus <burnus>
Component: fortranAssignee: janus
Status: RESOLVED FIXED    
Severity: normal CC: domob, janus, sfilippone
Priority: P3 Keywords: wrong-code
Version: 4.6.0   
Target Milestone: ---   
Host: Target:
Build: Known to work:
Known to fail: Last reconfirmed: 2010-11-05 09:48:16
Bug Depends on:    
Bug Blocks: 45451    

Description Tobias Burnus 2010-10-25 21:45:20 UTC
The following is in a sense a follow up to PR 45451.

Assuming that X and Y are both polymorphic (CLASS) and the following operation:
  ALLOCATE (x, SOURCE=y)
or
  x = y ! Fortran 2008: (Re)alloc on assignment with polymorphic LHS

In those cases, one might need to do a deep copy as the polymorphic item might have allocatable components. This currently does not work.

Example:

  1  2  3  4  5  6  7  8  9 10
 11 12 13 14 15 16 17 18 19 20
 11 12 13 14 15 16 17 18 19 20
Aborted (core dumped)

The third line should be the same as the first one - but in reality it still points to the allocatable components of the SOURCE=.


implicit none
type t
end type t

type, extends(t) :: t2
  integer, allocatable :: a(:)
end type t2

class(t), allocatable :: x, y
integer :: i

allocate(t2 :: x)
select type(x)
 type is (t2)
   allocate(x%a(10))
   x%a = [ (i, i = 1,10) ]
   print '(*(i3))', x%a
 class default
   call abort()
end select

allocate(y, source=x)

select type(x)
 type is (t2)
   x%a = [ (i, i = 11,20) ]
   print '(*(i3))', x%a
 class default
   call abort()
end select

select type(y)
 type is (t2)
   print '(*(i3))', y%a
   if (any (y%a /= [ (i, i = 1,10) ])) call abort()
 class default
   call abort()
end select
end
Comment 1 Salvatore Filippone 2010-10-26 07:09:41 UTC
(In reply to comment #0)
> The following is in a sense a follow up to PR 45451.
> 
> Assuming that X and Y are both polymorphic (CLASS) and the following operation:
>   ALLOCATE (x, SOURCE=y)
> or
>   x = y ! Fortran 2008: (Re)alloc on assignment with polymorphic LHS
>

What about MOLD= for polymorphic variables?
Comment 2 Tobias Burnus 2010-10-26 07:44:15 UTC
(In reply to comment #1)
> What about MOLD= for polymorphic variables?

MOLD= should work. Allocate with mold= allocates memory for the effective type of mold and initializes with the default initializer. By default, allocatable components are not allocated and thus there is no problem. (SOURCE= also works if (currently: and only if) all allocatable components are not allocated.)

 * * *

Similarly affected: Deallocation when leaving the scope: The allocatable components of the effective type are not deallocated. Example:

implicit none
type t
end type t

type, extends(t) :: t2
  integer, allocatable :: all
end type t2

class(t), allocatable :: a
if (allocated(a)) call foo()
end

If one looks at the dump, one sees that only allocatable components of the declared type ("t", here: none) but not allocatable components of the effective type are freed. I think that's tightly coupled to FINALization subroutines, i.e. PR 37336.
Comment 3 Tobias Burnus 2010-10-26 13:27:11 UTC
Possible implementation scheme:  vtab$t contains besides the normal type-bound procedures and init/size/hash also an two function points: $copy and $free, which are of the kind:

void $free (struct *DT) {
  ... free derived types
  if (DT->$vtab->$extends && DT->$vtab->$extends->$free)
    DT->$vtab->$extends->$free (DT)
}

That is, each effective type cleans up its own allocatable components and moves on to the parent. If the parent does not have an allocatable component itself, the $free pointer directly points to an ancestor which has -- or is NULL if no such ancestor exists.  The $copy version works alike.
Comment 4 Daniel Kraft 2010-10-26 19:00:34 UTC
(In reply to comment #3)
> Possible implementation scheme:  vtab$t contains besides the normal type-bound
> procedures and init/size/hash also an two function points: $copy and $free,
> which are of the kind:
> 
> void $free (struct *DT) {
>   ... free derived types
>   if (DT->$vtab->$extends && DT->$vtab->$extends->$free)
>     DT->$vtab->$extends->$free (DT)
> }
> 
> That is, each effective type cleans up its own allocatable components and moves
> on to the parent. If the parent does not have an allocatable component itself,
> the $free pointer directly points to an ancestor which has -- or is NULL if no
> such ancestor exists.  The $copy version works alike.

Note that this is basically what I would suggest to do also for finalization -- in principle, "all" that needs to be extended from your scheme is that $free also has to call the appropriate finalizer in-between the frees.  (This recursing on parent type is also exactly as finalization is specified by the standard.)

And because there may be multiple FINAL procedures differing in rank and the "correct one" must be called in any case, I fear that we have to create a $free for each rank, too (or play some nasty tricks).  But that should be more a mechanical change and bloat the resulting code instead of being hard to implement.
Comment 5 Tobias Burnus 2010-11-03 09:18:32 UTC
Draft patch for $free/$copy (w/o FINALize, cf. PR 37336):
  http://gcc.gnu.org/ml/fortran/2010-11/msg00030.html
Comment 6 janus 2010-11-05 18:15:02 UTC
Author: janus
Date: Fri Nov  5 18:14:52 2010
New Revision: 166368

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=166368
Log:
2010-11-05  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45451
	PR fortran/46174
	* class.c (gfc_find_derived_vtab): Improved search for existing vtab.
	Add component '$copy' to vtype symbol for polymorphic deep copying.
	* expr.c (gfc_check_pointer_assign): Make sure the vtab is generated
	during resolution stage.
	* resolve.c (resolve_codes): Don't resolve code if namespace is already
	resolved.
	* trans-stmt.c (gfc_trans_allocate): Call '$copy' procedure for
	polymorphic ALLOCATE statements with SOURCE.

2010-11-05  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45451
	PR fortran/46174
	* gfortran.dg/class_19.f03: Modified.
	* gfortran.dg/class_allocate_6.f03: New.

Added:
    trunk/gcc/testsuite/gfortran.dg/class_allocate_6.f03
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/class.c
    trunk/gcc/fortran/expr.c
    trunk/gcc/fortran/resolve.c
    trunk/gcc/fortran/trans-stmt.c
    trunk/gcc/testsuite/ChangeLog
    trunk/gcc/testsuite/gfortran.dg/class_19.f03
Comment 7 janus 2010-11-05 18:39:41 UTC
The deep copy issue is fixed by r166368. For poylmorphic deallocation (comment #2) I have opened PR 46321.