https://gcc.gnu.org/bugzilla/show_bug.cgi?id=49213
Paul Thomas <pault at gcc dot gnu.org> changed:
What |Removed |Added
----------------------------------------------------------------------------
CC| |pault at gcc dot gnu.org
Assignee|janus at gcc dot gnu.org |pault at gcc dot gnu.org
--- Comment #35 from Paul Thomas <pault at gcc dot gnu.org> ---
Created attachment 55383
--> https://gcc.gnu.org/bugzilla/attachment.cgi?id=55383&action=edit
Fix for this PR
Hello again Neil,
I had a tedious job to do, which I alleviated by fixing this bug :-)
Dejagnu-style testcase below.
Now the earliest surviving bug is gfortran-20160129.f90 and there are 22/64
remaining failures (there might be fewer; my octave test harness doesn't cope
with multiple sources yet).
Regards
Paul
! { dg-do run }
!
! Contributed by Neil Carlson <neil.n.carl...@gmail.com>
!
program main
character(2) :: c
type :: S
integer :: n
end type
type(S) :: Sobj
type, extends(S) :: S2
integer :: m
end type
type(S2) :: S2obj
type :: T
class(S), allocatable :: x
end type
type(T) :: Tobj
Sobj = S(1)
Tobj = T(Sobj)
S2obj = S2(1,2)
Tobj = T(S2obj) ! Failed here
select type (x => Tobj%x)
type is (S2)
if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 1
class default
stop 2
end select
c = " "
call pass_it (T(Sobj))
if (c .ne. "S ") stop 3
call pass_it (T(S2obj)) ! and here
if (c .ne. "S2") stop 4
contains
subroutine pass_it (foo)
type(T), intent(in) :: foo
select type (x => foo%x)
type is (S)
c = "S "
if (x%n .ne. 1) stop 5
type is (S2)
c = "S2"
if ((x%n .ne. 1) .or. (x%m .ne. 2)) stop 6
class default
stop 7
end select
end subroutine
end program
