[Bug fortran/56691] New: Allocatable array of extended type, wrong indexes after passing to a subroutine

[mrestelli at gmail dot com]

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

             Bug #: 56691
           Summary: Allocatable array of extended type, wrong indexes
                    after passing to a subroutine
    Classification: Unclassified
           Product: gcc
           Version: fortran-dev
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned@gcc.gnu.org
        ReportedBy: mrestelli@gmail.com


The attached code should display

Show: f1    1.0000000    
Show: f1    2.0000000    
Show: f1    3.0000000    
Show: f1    4.0000000   

three times - however the last call shows

Show: f1    2.0000000    
Show: f1    3.0000000    
Show: f1    4.0000000    
Show: f1    0.0000000    

i.e. all the array elements seem to be off by 1 (zero based
indexing?). Notice that:

1) the problem only shows up when the call to LCB uses array slices,
not when using the whole array

2) the problem disappears if the array WORK has explicit size.

I am using

gfortran --version
GNU Fortran (GCC) 4.9.0 20130322 (experimental)

Regards,
   Marco Restelli




module m1
 implicit none
 public :: c_stv
 private

 type, abstract :: c_stv
 contains
  procedure, pass(z) :: lcb
  procedure, pass(x) :: show
 end type c_stv

contains
 subroutine lcb(z,y)
  class(c_stv), intent(in) :: y(:)
  class(c_stv), intent(inout) :: z
  integer :: k
    write(*,*) 'Inside LCB: size is ',size(y)
    do k=1,size(y)
      call y(k)%show()
    enddo
 end subroutine lcb
 subroutine show(x)
  class(c_stv), intent(in) :: x
 end subroutine show
end module m1

module m2
 use m1, only: c_stv
 implicit none
 public :: t_stv
 private
 type, extends(c_stv) :: t_stv
  real :: f1
 contains
  procedure, pass(x) :: show
 end type t_stv
contains
 subroutine show(x)
  class(t_stv), intent(in) :: x
   write(*,*) 'Show: f1 ', x%f1
 end subroutine show
end module m2

program test
 use m1, only: c_stv
 use m2, only: t_stv

 implicit none

 integer :: k
 type(t_stv) :: x
 !type(t_stv) :: work(4) ! works fine
 type(t_stv), allocatable :: work(:)

  allocate(work(4))
  do k=1,4
    work(k)%f1 = real(k)
  enddo
  write(*,*) 'Values in work are:'
  do k=1,4
    call work(k)%show()
  enddo

  write(*,*) 'Call with whole array: works fine'
  call x%lcb(work)
  write(*,*) 'Call with array slice: off by 1'
  call x%lcb(work(:4))

end program test