5 ! Check the scalarizer/array packing with strides
6 ! in the finalization wrapper
17 type, extends(t1
) :: t1e
29 type, extends(t2
) :: t2e
38 final
:: fini_explicit
41 type, extends(t3
) :: t3e
44 final
:: fini_explicit2
47 integer :: cnt1
, cnt1e
, cnt2
, cnt2e
, cnt3
, cnt3e
51 impure elemental
subroutine fini_elem(x
)
52 type(t1
), intent(inout
) :: x
53 integer :: i
, j
, i2
, j2
55 if (cnt1e
/= 5*4) STOP 1
60 if (x
%i
/= j2
+ 100*i2
) STOP 2
63 end subroutine fini_elem
65 impure elemental
subroutine fini_elem2(x
)
66 type(t1e
), intent(inout
) :: x
67 integer :: i
, j
, i2
, j2
73 if (x
%i
/= j2
+ 100*i2
) STOP 3
74 if (x
%j
/= (j2
+ 100*i2
)*100) STOP 4
77 end subroutine fini_elem2
79 subroutine fini_shape(x
)
81 if (cnt2e
/= 1 .or
. cnt2
/= 0) STOP 5
82 call check_var_sec(x
%i
, 1)
85 end subroutine fini_shape
87 subroutine fini_shape2(x
)
89 call check_var_sec(x
%i
, 1)
90 call check_var_sec(x
%j
, 100)
93 end subroutine fini_shape2
95 subroutine fini_explicit(x
)
97 if (cnt3e
/= 1 .or
. cnt3
/= 0) STOP 6
98 call check_var_sec(x
%i
, 1)
101 end subroutine fini_explicit
103 subroutine fini_explicit2(x
)
105 call check_var_sec(x
%i
, 1)
106 call check_var_sec(x
%j
, 100)
109 end subroutine fini_explicit2
111 subroutine fin_test_1(x
)
112 class(t1
), intent(out
) :: x(5,4)
113 end subroutine fin_test_1
115 subroutine fin_test_2(x
)
116 class(t2
), intent(out
) :: x(:,:)
117 end subroutine fin_test_2
119 subroutine fin_test_3(x
)
120 class(t3
), intent(out
) :: x(:,:)
121 if (any (shape(x
) /= [5,4])) STOP 7
122 end subroutine fin_test_3
124 subroutine check_var_sec(x
, factor
)
126 integer, value
:: factor
127 integer :: i
, j
, i2
, j2
133 if (x(j
,i
) /= (j2
+ 100*i2
)*factor
) STOP 8
136 end subroutine check_var_sec
144 class(t1
), allocatable
:: x(:,:)
145 class(t2
), allocatable
:: y(:,:)
146 class(t3
), allocatable
:: z(:,:)
149 cnt1
= 0; cnt1e
= 0; cnt2
= 0; cnt2e
= 0; cnt3
= 0; cnt3e
= 0
151 allocate (t1e
:: x(10,10))
152 allocate (t2e
:: y(10,10))
153 allocate (t3e
:: z(10,10))
160 x(j
,i
)%j
= (j
+ 100*i
)*100
170 y(j
,i
)%j
= (j
+ 100*i
)*100
180 z(j
,i
)%j
= (j
+ 100*i
)*100
185 if (cnt1
+ cnt1e
+ cnt2
+ cnt2e
+ cnt3
+ cnt3e
/= 0) STOP 9
187 call fin_test_1(x(::2,::3))
188 if (cnt1
/= 5*4) STOP 10
189 if (cnt1e
/= 5*4) STOP 11
191 if (cnt2
+ cnt2e
+ cnt3
+ cnt3e
/= 0) STOP 12
193 call fin_test_2(y(::2,::3))
194 if (cnt2
/= 1) STOP 13
195 if (cnt2e
/= 1) STOP 14
197 if (cnt1
+ cnt1e
+ cnt3
+ cnt3e
/= 0) STOP 15
199 call fin_test_3(z(::2,::3))
200 if (cnt3
/= 1) STOP 16
201 if (cnt3e
/= 1) STOP 17
203 if (cnt1
+ cnt1e
+ cnt2
+ cnt2e
/= 0) STOP 18
207 call check_val(x
%i
, 1, 1)
208 call check_val(x
%j
, 100, 11)
213 call check_val(y
%i
, 1, 2)
214 call check_val(y
%j
, 100, 22)
219 call check_val(z
%i
, 1, 3)
220 call check_val(z
%j
, 100, 33)
224 subroutine check_val(x
, factor
, val
)
226 integer, value
:: factor
, val
230 if (mod (j
-1, 2) == 0 .and
. mod (i
-1, 3) == 0) then
231 if (x(j
,i
) /= val
) STOP 19
233 if (x(j
,i
) /= (j
+ 100*i
)*factor
) STOP 20
237 end subroutine check_val