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

[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

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

[janus at gcc dot gnu.org]

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

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
           Keywords|                            |wrong-code
             Status|UNCONFIRMED                 |NEW
   Last reconfirmed|                            |2012-10-25
                 CC|                            |janus at gcc dot gnu.org
     Ever Confirmed|0                           |1

--- Comment #1 from janus at gcc dot gnu.org 2012-10-25 11:35:20 UTC ---
Confirmed. I think this one is closely related to (if not a duplicate of) PR
54992, even though the case here is not a regression (it ICEs with 4.7).

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

[janus at gcc dot gnu.org]

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

--- Comment #2 from janus at gcc dot gnu.org 2012-10-25 11:58:15 UTC ---
-fdump-tree-original shows that the correct code is generated for the call to
"alt" in the main program (involving _vptr->_size):


        {
          struct __class_m_At1 class.17;
          static real(kind=4) C.2125 = 1.5e+0;
          struct __class_m_At1 class.16;
          struct __class_m_At1 class.15;

          class.15._data = (struct at1 *) aa.at2.work._data.data + (sizetype)
((aa.at2.work._data.offset + 2) * (integer(kind=8)) aa.at2.work._vptr->_size);
          class.15._vptr = aa.at2.work._vptr;
          class.16._data = (struct at1 *) aa.at2.work._data.data + (sizetype)
((aa.at2.work._data.offset + 1) * (integer(kind=8)) aa.at2.work._vptr->_size);
          class.16._vptr = aa.at2.work._vptr;
          class.17._data = (struct at1 *) aa.at2.work._data.data + (sizetype)
((aa.at2.work._data.offset + 1) * (integer(kind=8)) aa.at2.work._vptr->_size);
          class.17._vptr = aa.at2.work._vptr;
          aa.at2.work._vptr->alt (&class.15, &class.16, &C.2125, &class.17);
        }


while wrong code is generated for the call to "alt" in "sub":


sub (struct __class_m_At2 & restrict var)
{
  {
    struct __class_m_At1 class.2;
    static real(kind=4) C.1988 = 1.5e+0;
    struct __class_m_At1 class.1;
    struct __class_m_At1 class.0;

    class.0._data = &(*(struct at1[0:] * restrict)
var->_data->work._data.data)[var->_data->work._data.offset + 2];
    class.0._vptr = var->_data->work._vptr;
    class.1._data = &(*(struct at1[0:] * restrict)
var->_data->work._data.data)[var->_data->work._data.offset + 1];
    class.1._vptr = var->_data->work._vptr;
    class.2._data = &(*(struct at1[0:] * restrict)
var->_data->work._data.data)[var->_data->work._data.offset + 1];
    class.2._vptr = var->_data->work._vptr;
    var->_data->work._vptr->alt (&class.0, &class.1, &C.1988, &class.2);
  }
}

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

[janus at gcc dot gnu.org]

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

--- Comment #3 from janus at gcc dot gnu.org 2012-10-25 14:51:44 UTC ---
Here is a reduced test case, which is not usable as a runtime test, but shows
the wrong dump:


module m

 implicit none

 type :: t1
 end type

 type :: t2
   class(t1), allocatable :: work(:)
 end type

contains

 subroutine alt(x)
  class(t1), intent(in) :: x
 end subroutine

 subroutine sub1(a)
  type(t2) :: a
  call alt(a%work(1))
 end subroutine

 subroutine sub2(b)
  class(t2) :: b
  call alt(b%work(1))
 end subroutine

end module


The dump of 'sub2' is wrong in 4.8, while 'sub1' is ok. With 4.7, both are
wrong.

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

[janus at gcc dot gnu.org]

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

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |pault at gcc dot gnu.org

--- Comment #4 from janus at gcc dot gnu.org 2012-10-25 17:17:48 UTC ---
I think there is a problem with "build_array_ref" which was created by Paul in
this commit:

http://gcc.gnu.org/viewcvs?view=revision&revision=187192

Apparently it only handles expressions correctly, where the base symbol is
CLASS, but fails for those where it is TYPE. This also seems to be the reason
for the problems in PR 54992.

Paul, what would be the best way to fix this?

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

[janus at gcc dot gnu.org]

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

--- Comment #5 from janus at gcc dot gnu.org 2012-10-25 17:23:17 UTC ---
(In reply to comment #4)
> Apparently it only handles expressions correctly, where the base symbol is
> CLASS, but fails for those where it is TYPE.

Sorry, I meant the other way around.

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

[mikael at gcc dot gnu.org]

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

Mikael Morin <mikael at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |mikael at gcc dot gnu.org

--- Comment #6 from Mikael Morin <mikael at gcc dot gnu.org> ---
(In reply to janus from comment #3)
> Here is a reduced test case, which is not usable as a runtime test, but
> shows the wrong dump:
> 
[...]
> 
> The dump of 'sub2' is wrong in 4.8, while 'sub1' is ok. With 4.7, both are
> wrong.

sub2's dump is now:

sub2 (struct __class_m_T2 & restrict b)
{
  {
    struct __class_m_T1 class.7;

    class.7._data = (struct t1 *) b->_data->work._data.data + (sizetype)
((b->_data->work._data.offset + 1) * (integer(kind=8))
b->_data->work._vptr->_size);
    class.7._vptr = b->_data->work._vptr;
    alt (&class.7);
  }
}

This appears correct to me. At least, it "involves _vptr->_size".
And the output of comment #0 is now:

$ ./comment_0
 All the following values should be 2.0
   2.00000000
   2.00000000
   2.00000000
 All the following values should be 2.0
   2.00000000
   2.00000000
   2.00000000    

FIXED?

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

[dominiq at lps dot ens.fr]

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

--- Comment #7 from Dominique d'Humieres <dominiq at lps dot ens.fr> ---
It has been fixed between revisions 194721 and 195140.

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

[janus at gcc dot gnu.org]

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

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|NEW                         |RESOLVED
         Resolution|---                         |FIXED

--- Comment #8 from janus at gcc dot gnu.org ---
(In reply to Dominique d'Humieres from comment #7)
> It has been fixed between revisions 194721 and 195140.

I can confirm that it is fixed on trunk, so let's close it!

Btw, it even works for me with:

gcc version 4.8.1 20130806 [gcc-4_8-branch revision 201525] (SUSE Linux)

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

[janus at gcc dot gnu.org]

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

--- Comment #9 from janus at gcc dot gnu.org ---
(In reply to janus from comment #8)
> (In reply to Dominique d'Humieres from comment #7)
> > It has been fixed between revisions 194721 and 195140.
> 
> I can confirm that it is fixed on trunk, so let's close it!
> 
> Btw, it even works for me with:
> 
> gcc version 4.8.1 20130806 [gcc-4_8-branch revision 201525] (SUSE Linux)

... and, without testing, I assume it also works with the 4.8.0 release. This
assumption also matches Dominique's revision range (the 4.8 branch was created
only at r196696).