1! { dg-do run } 2! 3! PR fortran/57365 4! [OOP] Sourced allocation fails with unlimited polymorphism 5! Contributed by <rxs@hotmail.de> 6! 7program bug 8 9 implicit none 10 character(len=:), allocatable :: test 11 12 test = "A test case" 13 call allocate_test(test) 14 deallocate(test) 15 16contains 17 18 subroutine allocate_test(var) 19 class(*) :: var 20 class(*), pointer :: copyofvar 21 allocate(copyofvar, source=var) 22 select type (copyofvar) 23 type is (character(len=*)) 24! print*, len(copyofvar), copyofvar 25 if (len(copyofvar) /= 11) call abort () 26 if (copyofvar /= "A test case") call abort () 27 end select 28 deallocate(copyofvar) 29 end subroutine 30 31end program bug 32