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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
C
C File: sort_SortTest_Impl.f
C Symbol: sort.SortTest-v0.1
C Symbol Type: class
C Babel Version: 0.10.2
C Description: Server-side implementation for sort.SortTest
C
C WARNING: Automatically generated; only changes within splicers preserved
C
C babel-version = 0.10.2
C
C
C Symbol "sort.SortTest" (version 0.1)
C
C Run a bunch of sorts through a stress test.
C
C DO-NOT-DELETE splicer.begin(_miscellaneous_code_start)
subroutine intToString(ivalue, str, strlen)
integer*4 ivalue, copy, ten, strlen
character(*) str
character(80) buffer
logical isneg
integer i, j, k
copy = ivalue
ten = 10
i = 1
j = 1
str = ''
if (copy .lt. 0) then
str(j:j) = '-'
j = j + 1
copy = -copy
end if
100 buffer(i:i) = char(ichar('0') + mod(copy,ten))
i = i + 1
copy = copy / 10
if (copy .ne. 0) go to 100
c the string is done but reversed
do k = 1, i-1
str(j:j) = buffer(i - k:i - k)
j = j + 1
enddo
strlen = j - 1
end
subroutine sortAndReport(alg, cont, comp)
implicit none
integer*8 alg, cont, comp
integer*8 swpCnt, cmpCnt, tracker
integer*4 numswap, numcmp
character*(80) cmpbuf, swapbuf
integer*4 cmplen, swaplen
call sort_SortingAlgorithm_reset_f(alg)
call sort_SortingAlgorithm_sort_f(alg, cont, comp)
call sort_SortingAlgorithm_getSwapCounter_f(alg, swpCnt)
call sort_Counter_getCount_f(swpCnt, numswap)
call sort_Counter_deleteRef_f(swpCnt)
call sort_SortingAlgorithm_getCompareCounter_f(alg, cmpCnt)
call sort_Counter_getCount_f(cmpCnt, numcmp)
call sort_Counter_deleteRef_f(cmpCnt)
call intToString(numcmp, cmpbuf, cmplen)
call intToString(numswap, swapbuf, swaplen)
call synch_RegOut_getInstance_f(tracker)
call synch_RegOut_writeComment_f(tracker,
$ 'compares (' // cmpbuf(1:cmplen) // ') swaps (' //
$ swapbuf(1:swaplen) // ')')
call synch_RegOut_deleteRef_f(tracker)
end
logical function notSorted(cont, comp)
implicit none
integer*8 cont, comp
integer*4 length, i, result
call sort_Container_getLength_f(cont, length)
do i = 1, length - 1
call sort_Container_compare_f(cont, i-1, i, comp, result)
if (result .gt. 0) then
notSorted = .true.
goto 100
endif
enddo
notSorted = .false.
100 return
end
subroutine testAlgorithm(alg, retval)
implicit none
integer*8 alg
integer*8 data, cont, intcomp, comp
integer*8 tracker
character*30 name
logical notSorted, retval
integer*4 j, testsizes(10), datalen
character*80 databuf
data testsizes / 0, 1, 2, 3, 4, 7, 10, 51, 100, -1 /
call synch_RegOut_getInstance_f(tracker)
call sort_SortingAlgorithm_getName_f(alg, name)
call synch_RegOut_writeComment_f(tracker,
$ '****ALGORITHM IS ' // name // '****')
call sort_IntegerContainer__create_f(data)
call sort_Container__cast_f(data, cont)
call sort_CompInt__create_f(intcomp)
call sort_Comparator__cast_f(intcomp, comp)
j = 1
do while (testsizes(j) .ge. 0)
call sort_CompInt_setSortIncreasing_f(intcomp, .true.)
call intToString(testsizes(j), databuf, datalen)
call synch_RegOut_writeComment_f(tracker,
$ 'DATA SIZE ' // databuf(1:datalen))
call sort_IntegerContainer_setLength_f(data, testsizes(j))
call sortAndReport(alg, cont, comp)
if (notSorted(cont, comp)) then
call synch_RegOut_writeComment_f(tracker,
$ 'sort failed!!')
retval = .false.
endif
call synch_RegOut_writeComment_f(tracker,
$ 'pre-sorted list')
call sortAndReport(alg, cont, comp)
if (notSorted(cont, comp)) then
call synch_RegOut_writeComment_f(tracker,
$ 'sort failed!!')
retval = .false.
endif
call synch_RegOut_writeComment_f(tracker,
$ 'reverse sorted list')
call sort_CompInt_setSortIncreasing_f(intcomp, .false.)
call sortAndReport(alg, cont, comp)
if (notSorted(cont, comp)) then
call synch_RegOut_writeComment_f(tracker,
$ 'sort failed!!')
retval = .false.
endif
j = j + 1
enddo
call sort_IntegerContainer_deleteRef_f(data)
call sort_SortingAlgorithm_deleteRef_f(alg)
call sort_CompInt_deleteRef_f(intcomp)
call synch_RegOut_deleteRef_f(tracker)
end
C DO-NOT-DELETE splicer.end(_miscellaneous_code_start)
C
C Class constructor called when the class is created.
C
subroutine sort_SortTest__ctor_fi(self)
implicit none
C in sort.SortTest self
integer*8 self
C DO-NOT-DELETE splicer.begin(sort.SortTest._ctor)
C Insert the implementation here...
C DO-NOT-DELETE splicer.end(sort.SortTest._ctor)
end
C
C Class destructor called when the class is deleted.
C
subroutine sort_SortTest__dtor_fi(self)
implicit none
C in sort.SortTest self
integer*8 self
C DO-NOT-DELETE splicer.begin(sort.SortTest._dtor)
C Insert the implementation here...
C DO-NOT-DELETE splicer.end(sort.SortTest._dtor)
end
C
C Static class initializer called exactly once before any user-defined method is dispatched
C
subroutine sort_SortTest__load_fi()
implicit none
C DO-NOT-DELETE splicer.begin(sort.SortTest._load)
C Insert the implementation here...
C DO-NOT-DELETE splicer.end(sort.SortTest._load)
end
C
C Perform the array stress test.
C
C Return true if all the algorithms work okay.
C
subroutine sort_SortTest_stressTest_fi(algs, retval)
implicit none
C in array<sort.SortingAlgorithm> algs
integer*8 algs
C out bool retval
logical retval
C DO-NOT-DELETE splicer.begin(sort.SortTest.stressTest)
integer*4 lower, upper, i
integer*8 alg
if (algs .ne. 0) then
call sort_SortingAlgorithm__array_lower_f(algs, 0, lower)
call sort_SortingAlgorithm__array_upper_f(algs, 0, upper)
retval = .true.
do i = lower, upper
call sort_SortingAlgorithm__array_get1_f(algs, i, alg)
if (alg .ne. 0) then
call testAlgorithm(alg, retval)
else
retval = .false.
endif
enddo
endif
C DO-NOT-DELETE splicer.end(sort.SortTest.stressTest)
end
C DO-NOT-DELETE splicer.begin(_miscellaneous_code_end)
C Insert extra code here...
C DO-NOT-DELETE splicer.end(_miscellaneous_code_end)
|
