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