1! Test default initialization of local and dummy variables (dynamic initialization)
2! RUN: bbc -emit-fir %s -o - | FileCheck %s
3
4module test_dinit
5  type t
6    integer :: i = 42
7  end type
8  type t_alloc_comp
9    real, allocatable :: i(:)
10  end type
11  type tseq
12    sequence
13    integer :: i = 42
14  end type
15contains
16
17! -----------------------------------------------------------------------------
18!            Test default initialization of local and dummy variables.
19! -----------------------------------------------------------------------------
20
21  ! Test local scalar is default initialized
22  ! CHECK-LABEL: func @_QMtest_dinitPlocal()
23  subroutine local
24    ! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt{i:i32}>
25    ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>
26    ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
27    ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
28    type(t) :: x
29    print *, x%i
30  end subroutine
31
32  ! Test local array is default initialized
33  ! CHECK-LABEL: func @_QMtest_dinitPlocal_array()
34  subroutine local_array()
35    ! CHECK: %[[x:.*]] = fir.alloca !fir.array<4x!fir.type<_QMtest_dinitTt{i:i32}>>
36    ! CHECK: %[[xshape:.*]] = fir.shape %c4{{.*}} : (index) -> !fir.shape<1>
37    ! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshape]]) : (!fir.ref<!fir.array<4x!fir.type<_QMtest_dinitTt{i:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.array<4x!fir.type<_QMtest_dinitTt{i:i32}>>>
38    ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
39    ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
40    type(t) :: x(4)
41    print *, x(2)%i
42  end subroutine
43
44  ! Test allocatable component triggers default initialization of local
45  ! scalars.
46  ! CHECK-LABEL: func @_QMtest_dinitPlocal_alloc_comp()
47  subroutine local_alloc_comp
48    ! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}>
49    ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>) -> !fir.box<!fir.type<_QMtest_dinitTt_alloc_comp{i:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>
50    ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
51    ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
52    type(t_alloc_comp) :: x
53  end subroutine
54
55  ! Test function results are default initialized.
56  ! CHECK-LABEL: func @_QMtest_dinitPresult() -> !fir.type<_QMtest_dinitTt{i:i32}>
57  function result()
58    ! CHECK: %[[x:.*]] = fir.alloca !fir.type<_QMtest_dinitTt{i:i32}>
59    ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>
60    ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
61    ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
62    type(t) :: result
63  end function
64
65  ! Test intent(out) dummies are default initialized
66  ! CHECK-LABEL: func @_QMtest_dinitPintent_out(
67  ! CHECK-SAME: %[[x:.*]]: !fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>
68  subroutine intent_out(x)
69    ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QMtest_dinitTt{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>
70    ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
71    ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
72    type(t), intent(out) :: x
73  end subroutine
74
75  ! Test that optional intent(out) are default initialized only when
76  ! present.
77  ! CHECK-LABEL: func @_QMtest_dinitPintent_out_optional(
78  ! CHECK-SAME: %[[x:.*]]: !fir.box<!fir.type<_QMtest_dinitTt{i:i32}>> {fir.bindc_name = "x", fir.optional})
79  subroutine intent_out_optional(x)
80    ! CHECK: %[[isPresent:.*]] = fir.is_present %[[x]] : (!fir.box<!fir.type<_QMtest_dinitTt{i:i32}>>) -> i1
81    ! CHECK: fir.if %[[isPresent]] {
82      ! CHECK: %[[xboxNone:.*]] = fir.convert %[[x]]
83      ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
84    ! CHECK: }
85    type(t), intent(out), optional :: x
86  end subroutine
87
88  ! Test local equivalences where one entity has default initialization
89  ! CHECK-LABEL: func @_QMtest_dinitPlocal_eq()
90  subroutine local_eq()
91    type(tseq) :: x
92    integer :: zi
93    ! CHECK: %[[equiv:.*]] = fir.alloca !fir.array<4xi8>
94    ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
95    ! CHECK: %[[x:.*]] = fir.convert %[[xcoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>
96    ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTtseq{i:i32}>>
97    ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
98    ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
99    equivalence (x, zi)
100    print *, i
101  end subroutine
102
103  ! Test local equivalences with both equivalenced entities being
104  ! default initialized. Note that the standard allow default initialization
105  ! to be performed several times as long as the values are the same. So
106  ! far that is what lowering is doing to stay simple.
107  ! CHECK-LABEL: func @_QMtest_dinitPlocal_eq2()
108  subroutine local_eq2()
109    type(tseq) :: x
110    type(tseq) :: y
111    ! CHECK: %[[equiv:.*]] = fir.alloca !fir.array<4xi8>
112    ! CHECK: %[[xcoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
113    ! CHECK: %[[x:.*]] = fir.convert %[[xcoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>
114    ! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTtseq{i:i32}>>
115    ! CHECK: %[[xboxNone:.*]] = fir.convert %[[xbox]]
116    ! CHECK: fir.call @_FortranAInitialize(%[[xboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
117
118
119    ! CHECK: %[[ycoor:.*]] = fir.coordinate_of %[[equiv]], %c0{{.*}} : (!fir.ref<!fir.array<4xi8>>, index) -> !fir.ref<i8>
120    ! CHECK: %[[y:.*]] = fir.convert %[[ycoor]] : (!fir.ref<i8>) -> !fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>
121    ! CHECK: %[[ybox:.*]] = fir.embox %[[y]] : (!fir.ptr<!fir.type<_QMtest_dinitTtseq{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTtseq{i:i32}>>
122    ! CHECK: %[[yboxNone:.*]] = fir.convert %[[ybox]]
123    ! CHECK: fir.call @_FortranAInitialize(%[[yboxNone]], %{{.*}}, %{{.*}}) : (!fir.box<none>, !fir.ref<i8>, i32) -> none
124    equivalence (x, y)
125    print *, y%i
126  end subroutine
127
128
129! -----------------------------------------------------------------------------
130!        Test for local and dummy variables that must not be initialized
131! -----------------------------------------------------------------------------
132
133  ! CHECK-LABEL: func @_QMtest_dinitPnoinit_local_alloc
134  subroutine noinit_local_alloc
135    ! CHECK-NOT: fir.call @_FortranAInitialize
136    type(t), allocatable :: x
137    ! CHECK: return
138  end subroutine
139
140  ! CHECK-LABEL: func @_QMtest_dinitPnoinit_local_pointer
141  subroutine noinit_local_pointer
142    ! CHECK-NOT: fir.call @_FortranAInitialize
143    type(t), pointer :: x
144    ! CHECK: return
145  end subroutine
146
147  ! CHECK-LABEL: func @_QMtest_dinitPnoinit_normal_dummy
148  subroutine noinit_normal_dummy(x)
149    ! CHECK-NOT: fir.call @_FortranAInitialize
150    type(t) :: x
151    ! CHECK: return
152  end subroutine
153
154  ! CHECK-LABEL: func @_QMtest_dinitPnoinit_intentinout_dummy
155  subroutine noinit_intentinout_dummy(x)
156    ! CHECK-NOT: fir.call @_FortranAInitialize
157    type(t), intent(inout) :: x
158    ! CHECK: return
159  end subroutine
160
161end module
162
163! End-to-end test for debug pruposes.
164  use test_dinit
165  type(t) :: at
166  call local()
167  call local_array()
168  at%i = 66
169  call intent_out(at)
170  print *, at%i
171  at%i = 66
172  call intent_out_optional(at)
173  print *, at%i
174  call intent_out_optional()
175  call local_eq()
176  call local_eq2()
177end
178