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) call abort ()
60 if (x
%i
/= j2
+ 100*i2
) call abort ()
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
) call abort ()
74 if (x
%j
/= (j2
+ 100*i2
)*100) call abort ()
77 end subroutine fini_elem2
79 subroutine fini_shape(x
)
81 if (cnt2e
/= 1 .or
. cnt2
/= 0) call abort ()
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) call abort ()
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])) call abort ()
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
) call abort ()
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) call abort()
187 call fin_test_1(x(::2,::3))
188 if (cnt1
/= 5*4) call abort ()
189 if (cnt1e
/= 5*4) call abort ()
191 if (cnt2
+ cnt2e
+ cnt3
+ cnt3e
/= 0) call abort()
193 call fin_test_2(y(::2,::3))
194 if (cnt2
/= 1) call abort ()
195 if (cnt2e
/= 1) call abort ()
197 if (cnt1
+ cnt1e
+ cnt3
+ cnt3e
/= 0) call abort()
199 call fin_test_3(z(::2,::3))
200 if (cnt3
/= 1) call abort ()
201 if (cnt3e
/= 1) call abort ()
203 if (cnt1
+ cnt1e
+ cnt2
+ cnt2e
/= 0) call abort()
207 call check_val(x
%i
, 1)
208 call check_val(x
%j
, 100)
213 call check_val(y
%i
, 1)
214 call check_val(y
%j
, 100)
219 call check_val(z
%i
, 1)
220 call check_val(z
%j
, 100)
224 subroutine check_val(x
, factor
)
226 integer, value
:: factor
230 if (mod (j
-1, 2) == 0 .and
. mod (i
-1, 3) == 0) then
231 if (x(j
,i
) /= (j
+ 100*i
)*factor
*(-13)) call abort ()
233 if (x(j
,i
) /= (j
+ 100*i
)*factor
) call abort ()
237 end subroutine check_val