Bug 55057 - [OOP] wrong result with abstract type
Summary: [OOP] wrong result with abstract type
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.8.0
: P3 normal
Target Milestone: ---
Assignee: Not yet assigned to anyone
URL:
Keywords: wrong-code
Depends on:
Blocks:
 
Reported: 2012-10-24 15:35 UTC by mrestelli
Modified: 2013-08-08 15:22 UTC (History)
4 users (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2012-10-25 00:00:00


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description mrestelli 2012-10-24 15:35:30 UTC
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
Comment 1 janus 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).
Comment 2 janus 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);
  }
}
Comment 3 janus 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.
Comment 4 janus 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?
Comment 5 janus 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.
Comment 6 Mikael Morin 2013-06-11 17:15:21 UTC
(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?
Comment 7 Dominique d'Humieres 2013-06-11 18:34:57 UTC
It has been fixed between revisions 194721 and 195140.
Comment 8 janus 2013-08-08 15:15:18 UTC
(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)
Comment 9 janus 2013-08-08 15:22:22 UTC
(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).