mirror of
https://github.com/autc04/Retro68.git
synced 2024-09-28 18:56:06 +00:00
32 lines
742 B
Fortran
32 lines
742 B
Fortran
! { 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
|