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: [email protected]
ReportedBy: [email protected]
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
