1! { dg-do compile }
2!
3! PR 55037: [4.8 Regression] [OOP] ICE with local allocatable variable of abstract type
4!
5! Contributed by <mrestelli@gmail.com>
6
7module m1
8 implicit none
9 type, abstract :: c_stv
10 contains
11  procedure, pass(x) :: source
12 end type c_stv
13contains
14 subroutine source(y,x)
15  class(c_stv), intent(in)               :: x
16  class(c_stv), allocatable, intent(out) :: y
17 end subroutine source
18end module m1
19
20module m2
21 use m1, only : c_stv
22 implicit none
23contains
24 subroutine sub(u0)
25  class(c_stv), intent(inout) :: u0
26  class(c_stv), allocatable :: tmp
27   call u0%source(tmp)
28 end subroutine sub
29end module m2
30
31
32program p
33 implicit none
34 type :: c_stv
35 end type
36 class(c_stv), allocatable :: tmp
37 call source(tmp)
38contains
39 subroutine source(y)
40  type(c_stv), allocatable, intent(out) :: y
41 end subroutine
42end
43