[Bug fortran/55057] New: [OOP] wrong result with abstract type

[mrestelli at gmail dot com]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=55057

             Bug #: 55057
           Summary: [OOP] wrong result with abstract type
    Classification: Unclassified
           Product: gcc
           Version: 4.8.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned@gcc.gnu.org
        ReportedBy: mrestelli@gmail.com


The attached code compiles and runs, but the results are not correct.
Unfortunately the reduced test is not very much reduced, however I
think the problem is that in alt the storages of x, y and z overlap.

Notice that the problem is present only when calling alt through an
additional subroutine sub, as indicated by the comments.

gfortran --version
GNU Fortran (GCC) 4.8.0 20121024 (experimental)

./test 
 All the following values should be 2.0
   2.00000000    
   2.00000000    
   2.00000000    
 All the following values should be 2.0
   2.00000000    
   3.00000000    
   6.00000000    



module m

 implicit none

 public :: &
   at1, at2, t1, t2, sub

 private

 type, abstract :: at1
 contains
  procedure(i_copy), deferred, pass(z) :: copy
  procedure(i_incr), deferred, pass(x) :: incr
  procedure(i_tims), deferred, pass(x) :: tims
  procedure(i_show), deferred, pass(x) :: show
  procedure,                   pass(z) :: add
  procedure,                   pass(z) :: mlt
  procedure,                   pass(z) :: alt
 end type at1
 abstract interface
  pure subroutine i_copy(z,x)
   import :: at1
   implicit none
   class(at1), intent(in)    :: x
   class(at1), intent(inout) :: z
  end subroutine i_copy
 end interface
 abstract interface
  pure subroutine i_incr(x,y)
   import :: at1
   implicit none
   class(at1), intent(in)    :: y
   class(at1), intent(inout) :: x
  end subroutine i_incr
 end interface
 abstract interface
  pure subroutine i_tims(x,r)
   import :: at1
   implicit none
   real,       intent(in)    :: r
   class(at1), intent(inout) :: x
  end subroutine i_tims
 end interface
 abstract interface
  subroutine i_show(x)
   import :: at1
   implicit none
   class(at1), intent(in) :: x
  end subroutine i_show
 end interface

 type, abstract :: at2
  class(at1), allocatable :: work(:)
 end type at2

 type, extends(at1) :: t1
  real, allocatable :: f(:)
 contains
  procedure, pass(x) :: incr
  procedure, pass(x) :: tims
  procedure, pass(z) :: copy
  procedure, pass(x) :: show
 end type t1

 type, extends(at2) :: t2
 end type t2

contains

 subroutine alt(z,x,r,y)
  real,       intent(in) :: r
  class(at1), intent(in) :: x, y
  class(at1), intent(inout) :: z

   print *, 'All the following values should be 2.0'
   call y%show()
   call z%mlt(r,y)  ! z = r * y
   call y%show()
   call z%incr(x)   ! z = z + x
   call y%show()

 end subroutine alt

 pure subroutine add(z,x,y)
  class(at1), intent(in) :: x, y
  class(at1), intent(inout) :: z
   call z%copy( x )
   call z%incr( y )
 end subroutine add

 pure subroutine mlt(z,r,x)
  real, intent(in) :: r
  class(at1), intent(in) :: x
  class(at1), intent(inout) :: z
   call z%copy( x )
   call z%tims( r )
 end subroutine mlt

 pure subroutine copy(z,x)
  class(at1), intent(in)    :: x
  class(t1),  intent(inout) :: z

   select type(x); type is(t1)
   z%f = x%f
   end select
 end subroutine copy

 pure subroutine incr(x,y)
  class(at1), intent(in)    :: y
  class(t1),  intent(inout) :: x
   select type(y); type is(t1)
   x%f = x%f + y%f
   end select
 end subroutine incr

 pure subroutine tims(x,r)
  real,      intent(in)    :: r
  class(t1), intent(inout) :: x
   x%f = r*x%f
 end subroutine tims

 subroutine show(x)
  class(t1), intent(in) :: x
   write(*,*) x%f
 end subroutine show

 subroutine sub(var)
  class(at2), intent(inout) :: var
   call var%work(2)%alt(var%work(1),1.5,var%work(1))
 end subroutine sub

end module m


program p
 use m, only: t1, t2, sub
 implicit none
 integer :: i
 type(t2) :: aa

  allocate(t1::aa%work(2))
  select type(y=>aa%work); type is(t1)
  do i=1,2
    allocate(y(i)%f(1))
    y(i)%f = 2.0
  enddo
  end select
  ! This call to ALT works as expected
  call aa%work(2)%alt(aa%work(1),1.5,aa%work(1))
  ! Calling ALT from SUB however does not work
  call sub(aa)

end program p