1! { dg-do run }
2! { dg-options "-fdump-tree-original" }
3!
4! PR fortran/48820
5!
6! Test TYPE(*)
7!
8
9module mod
10  use iso_c_binding, only: c_loc, c_ptr, c_bool
11  implicit none
12  interface my_c_loc
13    function my_c_loc1(x) bind(C)
14      import c_ptr
15      type(*) :: x
16      type(c_ptr) :: my_c_loc1
17    end function
18    function my_c_loc2(x) bind(C)
19      import c_ptr
20      type(*) :: x(*)
21      type(c_ptr) :: my_c_loc2
22    end function
23  end interface my_c_loc
24contains
25  subroutine sub_scalar (arg1, presnt)
26     type(*), target, optional :: arg1
27     logical :: presnt
28     type(c_ptr) :: cpt
29     if (presnt .neqv. present (arg1)) STOP 1
30     cpt = c_loc (arg1)
31  end subroutine sub_scalar
32
33  subroutine sub_array_shape (arg2, lbounds, ubounds)
34     type(*), target :: arg2(:,:)
35     type(c_ptr) :: cpt
36     integer :: lbounds(2), ubounds(2)
37     if (any (lbound(arg2) /= lbounds)) STOP 2
38     if (any (ubound(arg2) /= ubounds)) STOP 3
39     if (any (shape(arg2) /= ubounds-lbounds+1)) STOP 4
40     if (size(arg2) /= product (ubounds-lbounds+1)) STOP 5
41     if (rank (arg2) /= 2) STOP 6
42!     if (.not. is_continuous (arg2)) STOP 7 !<< Not yet implemented
43!     cpt = c_loc (arg2) ! << FIXME: Valid since TS29113
44     call sub_array_assumed (arg2)
45  end subroutine sub_array_shape
46
47  subroutine sub_array_assumed (arg3)
48     type(*), target :: arg3(*)
49     type(c_ptr) :: cpt
50     cpt = c_loc (arg3)
51  end subroutine sub_array_assumed
52end module
53
54use mod
55use iso_c_binding, only: c_int, c_null_ptr
56implicit none
57type t1
58  integer :: a
59end type t1
60type :: t2
61  sequence
62  integer :: b
63end type t2
64type, bind(C) :: t3
65  integer(c_int) :: c
66end type t3
67
68integer            :: scalar_int
69real, allocatable  :: scalar_real_alloc
70character, pointer :: scalar_char_ptr
71
72integer            :: array_int(3)
73real, allocatable  :: array_real_alloc(:,:)
74character, pointer :: array_char_ptr(:,:)
75
76type(t1)              :: scalar_t1
77type(t2), allocatable :: scalar_t2_alloc
78type(t3), pointer     :: scalar_t3_ptr
79
80type(t1)              :: array_t1(4)
81type(t2), allocatable :: array_t2_alloc(:,:)
82type(t3), pointer     :: array_t3_ptr(:,:)
83
84class(t1), allocatable :: scalar_class_t1_alloc
85class(t1), pointer     :: scalar_class_t1_ptr
86
87class(t1), allocatable :: array_class_t1_alloc(:,:)
88class(t1), pointer     :: array_class_t1_ptr(:,:)
89
90scalar_char_ptr => null()
91scalar_t3_ptr => null()
92
93call sub_scalar (presnt=.false.)
94call sub_scalar (scalar_real_alloc, .false.)
95call sub_scalar (scalar_char_ptr, .false.)
96call sub_scalar (null (), .false.)
97call sub_scalar (scalar_t2_alloc, .false.)
98call sub_scalar (scalar_t3_ptr, .false.)
99
100allocate (scalar_real_alloc, scalar_char_ptr, scalar_t3_ptr)
101allocate (scalar_class_t1_alloc, scalar_class_t1_ptr, scalar_t2_alloc)
102allocate (array_real_alloc(3:5,2:4), array_char_ptr(-2:2,2))
103allocate (array_t2_alloc(3:5,2:4), array_t3_ptr(-2:2,2))
104allocate (array_class_t1_alloc(3,3), array_class_t1_ptr(4,4))
105
106call sub_scalar (scalar_int, .true.)
107call sub_scalar (scalar_real_alloc, .true.)
108call sub_scalar (scalar_char_ptr, .true.)
109call sub_scalar (array_int(2), .true.)
110call sub_scalar (array_real_alloc(3,2), .true.)
111call sub_scalar (array_char_ptr(0,1), .true.)
112call sub_scalar (scalar_t1, .true.)
113call sub_scalar (scalar_t2_alloc, .true.)
114call sub_scalar (scalar_t3_ptr, .true.)
115call sub_scalar (array_t1(2), .true.)
116call sub_scalar (array_t2_alloc(3,2), .true.)
117call sub_scalar (array_t3_ptr(0,1), .true.)
118call sub_scalar (array_class_t1_alloc(2,1), .true.)
119call sub_scalar (array_class_t1_ptr(3,3), .true.)
120
121call sub_array_assumed (array_int)
122call sub_array_assumed (array_real_alloc)
123call sub_array_assumed (array_char_ptr)
124call sub_array_assumed (array_t1)
125call sub_array_assumed (array_t2_alloc)
126call sub_array_assumed (array_t3_ptr)
127call sub_array_assumed (array_class_t1_alloc)
128call sub_array_assumed (array_class_t1_ptr)
129
130call sub_array_shape (array_real_alloc, [1,1], shape(array_real_alloc))
131call sub_array_shape (array_char_ptr, [1,1], shape(array_char_ptr))
132call sub_array_shape (array_t2_alloc, [1,1], shape(array_t2_alloc))
133call sub_array_shape (array_t3_ptr, [1,1], shape(array_t3_ptr))
134call sub_array_shape (array_class_t1_alloc, [1,1], shape(array_class_t1_alloc))
135call sub_array_shape (array_class_t1_ptr, [1,1], shape(array_class_t1_ptr))
136
137deallocate (scalar_char_ptr, scalar_class_t1_ptr, array_char_ptr)
138deallocate (array_class_t1_ptr, array_t3_ptr)
139
140end
141
142! { dg-final { scan-tree-dump-times "sub_scalar .0B,"  2 "original" } }
143! { dg-final { scan-tree-dump-times "sub_scalar .scalar_real_alloc," 2 "original" } }
144! { dg-final { scan-tree-dump-times "sub_scalar .scalar_char_ptr," 2 "original" } }
145! { dg-final { scan-tree-dump-times "sub_scalar .scalar_t2_alloc," 2 "original" } }
146! { dg-final { scan-tree-dump-times "sub_scalar .scalar_t3_ptr" 2 "original" } }
147
148! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_int," 1 "original" } }
149! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_t1," 1 "original" } }
150! { dg-final { scan-tree-dump-times "sub_scalar .&array_int.1.," 1 "original" } }
151! { dg-final { scan-tree-dump-times "sub_scalar .&scalar_t1," 1 "original" } }
152
153! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(real.kind=4..0:. . restrict\\) array_real_alloc.data" 1 "original" } }
154! { dg-final { scan-tree-dump-times "sub_scalar .\\(character.kind=1..1:1. .\\) .array_char_ptr.data" 1 "original" } }
155! { dg-final { scan-tree-dump-times "sub_scalar .&\\(.\\(struct t2.0:. . restrict\\) array_t2_alloc.data" 1 "original" } }
156! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t3 .\\) .array_t3_ptr.data" 1 "original" } }
157! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_alloc._data.data" 1 "original" } }
158! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) \\(array_class_t1_ptr._data.dat" 1 "original" } }
159
160! { dg-final { scan-tree-dump-times "sub_array_assumed \\(D" 4 "original" } }
161! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&parm" 1 "original" } }
162! { dg-final { scan-tree-dump-times "sub_array_assumed \\(&array_int\\)" 1 "original" } }
163! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(real\\(kind=4\\).0:. . restrict\\) array_real_alloc.data" 1 "original" } }
164! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&array_char_ptr\\);" 1 "original" } }
165! { dg-final { scan-tree-dump-times "\\.data = \\(void .\\) &array_t1.0.;" 1 "original" } }
166! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) parm" 1 "original" } }
167! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t2.0:. . restrict\\) array_t2_alloc.data\\);" 1 "original" } }
168! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. . restrict\\) array_class_t1_alloc._data.data\\);" 1 "original" } }
169! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) array_class_t1_ptr._data.data\\);" 0 "original" } }
170
171! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_real_alloc," 1 "original" } }
172! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_char_ptr," 1 "original" } }
173! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_t2_alloc," 1 "original" } }
174! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_t3_ptr," 1 "original" } }
175! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_class_t1_alloc._data," 1 "original" } }
176! { dg-final { scan-tree-dump-times "sub_array_shape \\(&array_class_t1_ptr._data," 1 "original" } }
177
178