1! { dg-do run }
2! { dg-options "-fdump-tree-original" }
3!
4! PR fortran/51435
5!
6! Contributed by darmar.xxl@gmail.com
7!
8module arr_m
9    type arr_t
10        real(8), dimension(:), allocatable :: rsk
11    end type
12    type arr_t2
13        integer :: a = 77
14    end type
15end module arr_m
16!*********************
17module list_m
18    use arr_m
19    implicit none
20
21    type(arr_t2), target :: tgt
22
23    type my_list
24        type(arr_t), pointer :: head => null()
25    end type my_list
26    type my_list2
27        type(arr_t2), pointer :: head => tgt
28    end type my_list2
29end module list_m
30!***********************
31module worker_mod
32    use list_m
33    implicit none
34
35    type data_all_t
36        type(my_list) :: my_data
37    end type data_all_t
38    type data_all_t2
39        type(my_list2) :: my_data
40    end type data_all_t2
41contains
42    subroutine do_job()
43        type(data_all_t) :: dum
44        type(data_all_t2) :: dum2
45
46        if (associated(dum%my_data%head)) then
47          call abort()
48        else
49            print *, 'OK: do_job my_data%head is NOT associated'
50        end if
51
52        if (dum2%my_data%head%a /= 77) &
53          call abort()
54    end subroutine
55end module
56!***************
57program hello
58    use worker_mod
59    implicit none
60    call do_job()
61end program
62
63! { dg-final { scan-tree-dump-times "my_data.head = 0B" 1 "original" } }
64! { dg-final { scan-tree-dump-times "my_data.head = &tgt" 1 "original" } }
65! { dg-final { cleanup-tree-dump "original" } }
66