1! { dg-do run }
2! { dg-options "-fdump-tree-original" }
3!
4! test for aliasing violations when converting class objects with
5! different target and pointer attributes.
6!
7module test_module
8
9  implicit none
10
11  type, public :: test
12    integer :: x
13  end type test
14
15contains
16
17  subroutine do_it6 (par2_t)
18    class (test), target :: par2_t
19    par2_t%x = par2_t%x + 1
20  end subroutine do_it6
21
22  subroutine do_it5 (par1_p)
23    class (test), pointer, intent(in) :: par1_p
24    ! pointer -> target
25    ! { dg-final { scan-tree-dump "par2_t\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par1_p" "original" } }
26    call do_it6 (par1_p)
27  end subroutine do_it5
28
29  subroutine do_it4 (par_p)
30    class (test), pointer, intent(in) :: par_p
31    ! pointer -> pointer
32    ! { dg-final { scan-tree-dump-not "par1_p\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par_p" "original" } }
33    call do_it5 (par_p)
34  end subroutine do_it4
35
36  subroutine do_it3 (par1_t)
37    class (test), target :: par1_t
38    ! target -> pointer
39    ! { dg-final { scan-tree-dump "par_p\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par1_t" "original" } }
40    call do_it4 (par1_t)
41  end subroutine do_it3
42
43  subroutine do_it2 (par_t)
44    class (test), target :: par_t
45    ! target -> target
46    ! { dg-final { scan-tree-dump-not "par1_t\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par_t" "original" } }
47    call do_it3 (par_t)
48  end subroutine do_it2
49
50  subroutine do_it1 (par1_a)
51    class (test), allocatable :: par1_a
52    ! allocatable -> target
53    ! { dg-final { scan-tree-dump "par_t\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par1_a" "original" } }
54    call do_it2 (par1_a)
55  end subroutine do_it1
56
57  subroutine do_it (par_a)
58    class (test), allocatable :: par_a
59    ! allocatable -> allocatable
60    ! { dg-final { scan-tree-dump-not "par1_a\[^\n]*VIEW_CONVERT_EXPR\[^\n]*par_a" "original" } }
61    call do_it1 (par_a)
62  end subroutine do_it
63
64end module test_module
65
66use test_module
67
68  implicit none
69  class (test), allocatable :: var_a
70  class (test), pointer :: var_p
71
72
73  allocate (var_a)
74  allocate (var_p)
75  var_a%x = 0
76  var_p%x = 0
77
78  ! allocatable -> allocatable
79  ! { dg-final { scan-tree-dump-not "par_a\[^\n]*VIEW_CONVERT_EXPR\[^\n]*var_a" "original" } }
80  call do_it (var_a)
81  ! allocatable -> target
82  ! { dg-final { scan-tree-dump "par_t\[^\n]*VIEW_CONVERT_EXPR\[^\n]*var_a" "original" } }
83  call do_it2 (var_a)
84  ! pointer -> target
85  ! { dg-final { scan-tree-dump "par_t\[^\n]*VIEW_CONVERT_EXPR\[^\n]*var_p" "original" } }
86  call do_it2 (var_p)
87  ! pointer -> pointer
88  ! { dg-final { scan-tree-dump-not "par_p\[^\n]*VIEW_CONVERT_EXPR\[^\n]*var_p" "original" } }
89  call do_it4 (var_p)
90  if (var_a%x .ne. 2) call abort()
91  if (var_p%x .ne. 2) call abort()
92  deallocate (var_a)
93  deallocate (var_p)
94end
95! { dg-final { cleanup-tree-dump "original" } }
96