! { dg-do run } ! { dg-options "-fcoarray=single" } ! ! PR fortran/50981 ! PR fortran/54618 ! implicit none type t integer, allocatable :: i end type t type, extends (t):: t2 integer, allocatable :: j end type t2 class(t), allocatable :: xa, xa2(:), xac[:], xa2c(:)[:] class(t), pointer :: xp, xp2(:) xp => null() xp2 => null() call suba(alloc=.false., prsnt=.false.) call suba(xa, alloc=.false., prsnt=.true.) if (.not. allocated (xa)) call abort () if (.not. allocated (xa%i)) call abort () if (xa%i /= 5) call abort () xa%i = -3 call suba(xa, alloc=.true., prsnt=.true.) if (allocated (xa)) call abort () call suba2(alloc=.false., prsnt=.false.) call suba2(xa2, alloc=.false., prsnt=.true.) if (.not. allocated (xa2)) call abort () if (size (xa2) /= 1) call abort () if (.not. allocated (xa2(1)%i)) call abort () if (xa2(1)%i /= 5) call abort () xa2(1)%i = -3 call suba2(xa2, alloc=.true., prsnt=.true.) if (allocated (xa2)) call abort () call subp(alloc=.false., prsnt=.false.) call subp(xp, alloc=.false., prsnt=.true.) if (.not. associated (xp)) call abort () if (.not. allocated (xp%i)) call abort () if (xp%i /= 5) call abort () xp%i = -3 call subp(xp, alloc=.true., prsnt=.true.) if (associated (xp)) call abort () call subp2(alloc=.false., prsnt=.false.) call subp2(xp2, alloc=.false., prsnt=.true.) if (.not. associated (xp2)) call abort () if (size (xp2) /= 1) call abort () if (.not. allocated (xp2(1)%i)) call abort () if (xp2(1)%i /= 5) call abort () xp2(1)%i = -3 call subp2(xp2, alloc=.true., prsnt=.true.) if (associated (xp2)) call abort () call subac(alloc=.false., prsnt=.false.) call subac(xac, alloc=.false., prsnt=.true.) if (.not. allocated (xac)) call abort () if (.not. allocated (xac%i)) call abort () if (xac%i /= 5) call abort () xac%i = -3 call subac(xac, alloc=.true., prsnt=.true.) if (allocated (xac)) call abort () call suba2c(alloc=.false., prsnt=.false.) call suba2c(xa2c, alloc=.false., prsnt=.true.) if (.not. allocated (xa2c)) call abort () if (size (xa2c) /= 1) call abort () if (.not. allocated (xa2c(1)%i)) call abort () if (xa2c(1)%i /= 5) call abort () xa2c(1)%i = -3 call suba2c(xa2c, alloc=.true., prsnt=.true.) if (allocated (xa2c)) call abort () contains subroutine suba2c(x, prsnt, alloc) class(t), optional, allocatable :: x(:)[:] logical prsnt, alloc if (present (x) .neqv. prsnt) call abort () if (prsnt) then if (alloc .neqv. allocated(x)) call abort () if (.not. allocated (x)) then allocate (x(1)[*]) x(1)%i = 5 else if (x(1)%i /= -3) call abort() deallocate (x) end if end if end subroutine suba2c subroutine subac(x, prsnt, alloc) class(t), optional, allocatable :: x[:] logical prsnt, alloc if (present (x) .neqv. prsnt) call abort () if (present (x)) then if (alloc .neqv. allocated(x)) call abort () if (.not. allocated (x)) then allocate (x[*]) x%i = 5 else if (x%i /= -3) call abort() deallocate (x) end if end if end subroutine subac subroutine suba2(x, prsnt, alloc) class(t), optional, allocatable :: x(:) logical prsnt, alloc if (present (x) .neqv. prsnt) call abort () if (prsnt) then if (alloc .neqv. allocated(x)) call abort () if (.not. allocated (x)) then allocate (x(1)) x(1)%i = 5 else if (x(1)%i /= -3) call abort() deallocate (x) end if end if end subroutine suba2 subroutine suba(x, prsnt, alloc) class(t), optional, allocatable :: x logical prsnt, alloc if (present (x) .neqv. prsnt) call abort () if (present (x)) then if (alloc .neqv. allocated(x)) call abort () if (.not. allocated (x)) then allocate (x) x%i = 5 else if (x%i /= -3) call abort() deallocate (x) end if end if end subroutine suba subroutine subp2(x, prsnt, alloc) class(t), optional, pointer :: x(:) logical prsnt, alloc if (present (x) .neqv. prsnt) call abort () if (present (x)) then if (alloc .neqv. associated(x)) call abort () if (.not. associated (x)) then allocate (x(1)) x(1)%i = 5 else if (x(1)%i /= -3) call abort() deallocate (x) end if end if end subroutine subp2 subroutine subp(x, prsnt, alloc) class(t), optional, pointer :: x logical prsnt, alloc if (present (x) .neqv. prsnt) call abort () if (present (x)) then if (alloc .neqv. associated(x)) call abort () if (.not. associated (x)) then allocate (x) x%i = 5 else if (x%i /= -3) call abort() deallocate (x) end if end if end subroutine subp end