blob: c9665309bc1ed99f13e9596da472cd3c60ea52f6 [file] [log] [blame]
! { dg-do run }
!
! PR fortran/57365
! [OOP] Sourced allocation fails with unlimited polymorphism
! Contributed by <rxs@hotmail.de>
!
program bug
implicit none
character(len=:), allocatable :: test
test = "A test case"
call allocate_test(test)
deallocate(test)
contains
subroutine allocate_test(var)
class(*) :: var
class(*), pointer :: copyofvar
allocate(copyofvar, source=var)
select type (copyofvar)
type is (character(len=*))
! print*, len(copyofvar), copyofvar
if (len(copyofvar) /= 11) STOP 1
if (copyofvar /= "A test case") STOP 2
end select
deallocate(copyofvar)
end subroutine
end program bug