https://gcc.gnu.org/bugzilla/show_bug.cgi?id=127413
--- Comment #2 from Mikael Morin <mikael at gcc dot gnu.org> ---
More extended testcase:
program prog
implicit none
integer, parameter :: k = 2
integer, parameter :: n = 5
type :: t1
integer(kind=k) :: c1, c2, c3
end type
type, extends(t1) :: t2
integer(kind=k) :: c4, c5
end type
type, extends(t2) :: t3
integer(kind=k) :: c6
end type
type(t3), target :: x(n)
class(t1), pointer :: y1(:), z1(:)
class(t2), pointer :: y2(:), z2(:)
class(t3), pointer :: y3(:), z3(:)
type(t2), pointer :: p2(:), q2(:)
type(t1), pointer :: p1(:), q1(:)
interface check
procedure :: check_int, check_log
end interface
call check_array(x, 6, .true., 1)
y3 => x
call check_array(y3, 6, .true., 11)
y2 => x
call check_array(y2, 6, .true., 12)
y1 => x
call check_array(y1, 6, .true., 13)
z3 => y3
call check_array(z3, 6, .true., 14)
z2 => y3
call check_array(z2, 6, .true., 15)
z1 => y3
call check_array(z1, 6, .true., 16)
z2 => y2
call check_array(z2, 6, .true., 17)
z1 => y2
call check_array(z1, 6, .true., 18)
z1 => y1
call check_array(z1, 6, .true., 19)
call check_array(x%t2, 5, .false., 21)
call check_array(y3%t2, 5, .false., 22)
y2 => x%t2
call check_array(y2, 5, .false., 23)
y1 => x%t2
call check_array(y1, 5, .false., 24)
z2 => y3%t2
call check_array(z2, 5, .false., 25)
z1 => y3%t2
call check_array(z1, 5, .false., 26)
z2 => y2
call check_array(z2, 5, .false., 27)
z1 => y2
call check_array(z1, 5, .false., 28)
call check_array(x%t1, 3, .false., 31)
call check_array(y3%t1, 3, .false., 32)
y1 => x%t1
call check_array(y1, 3, .false., 33)
z1 => y3%t1
call check_array(z1, 3, .false., 34)
z1 => y2%t1
call check_array(z1, 3, .false., 35)
z1 => y1
call check_array(z1, 3, .false., 36)
p2 => x%t2
call check_array(p2, 5, .false., 41)
p2 => y3%t2
call check_array(p2, 5, .false., 42)
p2 => y2
call check_array(p2, 5, .false., 43)
q2 => p2
call check_array(q2, 5, .false., 44)
p1 => x%t1
call check_array(p1, 3, .false., 51)
p1 => y3%t1
call check_array(p1, 3, .false., 52)
p1 => y2%t1
call check_array(p1, 3, .false., 53)
p1 => y1
call check_array(p1, 3, .false., 54)
q1 => p1
call check_array(q1, 3, .false., 55)
contains
subroutine check_array(arg, s, c, f)
type(*), target, intent(in) :: arg(:)
integer, intent(in) :: s, f
logical, intent(in) :: c
call check(int(sizeof(arg)), k*n*s, 10*f+1)
call check(is_contiguous(arg), c, 10*f+2)
end subroutine
subroutine check_int(v, e, f)
integer, intent(in) :: v, e, f
print *, f, (v == e ? "PASS" : "FAIL"), v, e
!if (v /= e) error stop f
end subroutine
subroutine check_log(v, e, f)
logical, intent(in) :: v, e
integer, intent(in) :: f
print *, f, (v .eqv. e ? "PASS" : "FAIL"), v, e
!if (v /= e) error stop f
end subroutine
end program
