1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
! { dg-do run }
! Like imperfect2.f90, but adds bindings to the blocks.
module m
implicit none
type t
integer :: i
contains
final :: fini
end type t
integer :: ccount(3), dcount(3)
contains
subroutine init(x, n)
type(t) :: x
integer :: n
x%i = n
ccount(x%i) = ccount(x%i) + 1
end subroutine init
subroutine fini(x)
type(t) :: x
dcount(x%i) = dcount(x%i) + 1
end subroutine fini
end module m
program foo
use m
integer :: f1count(3), f2count(3), g1count(3), g2count(3)
f1count(1) = 0
f1count(2) = 0
f1count(3) = 0
f2count(1) = 0
f2count(2) = 0
f2count(3) = 0
g1count(1) = 0
g1count(2) = 0
g1count(3) = 0
g2count(1) = 0
g2count(2) = 0
g2count(3) = 0
call s1 (3, 4, 5)
! All intervening code at the same depth must be executed the same
! number of times.
if (f1count(1) /= f2count(1)) error stop 101
if (f1count(2) /= f2count(2)) error stop 102
if (f1count(3) /= f2count(3)) error stop 103
if (g1count(1) /= f1count(1)) error stop 104
if (g2count(1) /= f1count(1)) error stop 105
if (g1count(2) /= f1count(2)) error stop 106
if (g2count(2) /= f1count(2)) error stop 107
if (g1count(3) /= f1count(3)) error stop 108
if (g2count(3) /= f1count(3)) error stop 109
! Intervening code must be executed at least as many times as the loop
! that encloses it.
if (f1count(1) < 3) error stop 111
if (f1count(2) < 3 * 4) error stop 112
! Intervening code must not be executed more times than the number
! of logical iterations.
if (f1count(1) > 3 * 4 * 5) error stop 121
if (f1count(2) > 3 * 4 * 5) error stop 122
! Check that the innermost loop body is executed exactly the number
! of logical iterations expected.
if (f1count(3) /= 3 * 4 * 5) error stop 131
! Check that constructors and destructors are called equal number of times.
if (ccount(1) /= dcount(1)) error stop 141
if (ccount(2) /= dcount(2)) error stop 142
if (ccount(3) /= dcount(3)) error stop 143
contains
subroutine f1 (depth, iter)
integer :: depth, iter
f1count(depth) = f1count(depth) + 1
end subroutine
subroutine f2 (depth, iter)
integer :: depth, iter
f2count(depth) = f2count(depth) + 1
end subroutine
subroutine g1 (depth, iter)
integer :: depth, iter
g1count(depth) = g1count(depth) + 1
end subroutine
subroutine g2 (depth, iter)
integer :: depth, iter
g2count(depth) = g2count(depth) + 1
end subroutine
subroutine s1 (a1, a2, a3)
integer :: a1, a2, a3
integer :: i, j, k
!$omp do collapse(3)
do i = 1, a1
call f1 (1, i)
block
type (t) :: local1
call init (local1, 1)
call g1 (local1%i, i)
do j = 1, a2
call f1 (2, j)
block
type (t) :: local2
call init (local2, 2)
call g1 (local2%i, j)
do k = 1, a3
call f1 (3, k)
block
type (t) :: local3
call init (local3, 3)
call g1 (local3%i, k)
call g2 (local3%i, k)
end block
call f2 (3, k)
end do
call g2 (local2%i, j)
end block
call f2 (2, j)
end do
call g2 (local1%i, i)
end block
call f2 (1, i)
end do
end subroutine
end program
|
