|
111
|
1 ! { dg-do run }
|
|
|
2 ! Tests the fix for PR68196
|
|
|
3 !
|
|
|
4 ! Contributed by Damian Rouson <damian@sourceryinstitute.org>
|
|
|
5 !
|
|
|
6 type AA
|
|
|
7 integer :: i
|
|
|
8 procedure(foo), pointer :: funct
|
|
|
9 end type
|
|
|
10 class(AA), allocatable :: my_AA
|
|
|
11 type(AA) :: res
|
|
|
12
|
|
|
13 allocate (my_AA, source = AA (1, foo))
|
|
|
14
|
|
|
15 res = my_AA%funct ()
|
|
|
16
|
|
131
|
17 if (res%i .ne. 3) STOP 1
|
|
|
18 if (.not.associated (res%funct)) STOP 2
|
|
|
19 if (my_AA%i .ne. 4) STOP 3
|
|
|
20 if (associated (my_AA%funct)) STOP 4
|
|
111
|
21
|
|
|
22 contains
|
|
|
23 function foo(A)
|
|
131
|
24 class(AA) :: A
|
|
111
|
25 type(AA) foo
|
|
|
26
|
|
|
27 select type (A)
|
|
|
28 type is (AA)
|
|
|
29 foo = AA (3, foo)
|
|
|
30 A = AA (4, NULL ())
|
|
|
31 end select
|
|
|
32 end function
|
|
|
33 end
|
