1 |
dpavlin |
237 |
#!/opt/openisis/tcl/bin/isish |
2 |
|
|
# |
3 |
|
|
# openisis - an open implementation of the ISIS database |
4 |
|
|
# Version 0.8.x (microversion see file Version) |
5 |
|
|
# Copyright (C) 2003 by Erik Grziwotz, erik@openisis.org |
6 |
|
|
# |
7 |
|
|
# This library is free software; you can redistribute it and/or |
8 |
|
|
# modify it under the terms of the GNU Lesser General Public |
9 |
|
|
# License as published by the Free Software Foundation; either |
10 |
|
|
# version 2.1 of the License, or (at your option) any later version. |
11 |
|
|
# |
12 |
|
|
# This library is distributed in the hope that it will be useful, |
13 |
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
14 |
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
15 |
|
|
# Lesser General Public License for more details. |
16 |
|
|
# |
17 |
|
|
# You should have received a copy of the GNU Lesser General Public |
18 |
|
|
# License along with this library; if not, write to the Free Software |
19 |
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
20 |
|
|
# |
21 |
|
|
# This software is dedicated to the memory of Eckart Dietrich. |
22 |
|
|
# |
23 |
|
|
# This software is inspired by (but contains no code of) the iAPI |
24 |
|
|
# Copyright (C) 2000 by Robert Janusz, rj@jezuici.krakow.pl. |
25 |
|
|
# See iAPI.txt for what it contains. |
26 |
|
|
# |
27 |
|
|
# $Id: teststb.tcl,v 1.19 2003/06/17 12:45:32 mawag Exp $ |
28 |
|
|
# test script for stub commands |
29 |
|
|
|
30 |
|
|
proc checklst {msg exp got} { |
31 |
|
|
if [catch { |
32 |
|
|
set len1 [llength $exp] |
33 |
|
|
set len2 [llength $got] |
34 |
|
|
if {$len1 != $len2} { |
35 |
|
|
puts "ERR $msg: length != $len1" |
36 |
|
|
puts "REC = $got" |
37 |
|
|
exit 1 |
38 |
|
|
} |
39 |
|
|
for {set j 0} {$len1 > $j} {incr j} { |
40 |
|
|
set gg [lindex $got $j] |
41 |
|
|
set ee [lindex $exp $j] |
42 |
|
|
if {! [string equal $gg $ee]} { |
43 |
|
|
puts "ERR $msg: got\[$j] = $gg, exp = $ee" |
44 |
|
|
puts "REC = $got" |
45 |
|
|
exit 1 |
46 |
|
|
} |
47 |
|
|
} |
48 |
|
|
}] { |
49 |
|
|
global errorInfo |
50 |
|
|
puts $errorInfo |
51 |
|
|
puts "REC = $got" |
52 |
|
|
exit 1 |
53 |
|
|
} |
54 |
|
|
} |
55 |
|
|
|
56 |
|
|
proc checkrec {msg cmd tag val complete} { |
57 |
|
|
set lst "" |
58 |
|
|
set witht "" |
59 |
|
|
if [catch { |
60 |
|
|
set lst [eval $cmd get] |
61 |
|
|
set witht [eval $cmd get -tags] |
62 |
|
|
set len [llength $val] |
63 |
|
|
if $complete { |
64 |
|
|
if {[llength $lst] != $len} { |
65 |
|
|
puts "ERR $msg: got len = [llength $lst], exp = $len" |
66 |
|
|
puts "REC = $witht" |
67 |
|
|
exit 1 |
68 |
|
|
} |
69 |
|
|
} |
70 |
|
|
for {set j 0} {$len > $j} {incr j} { |
71 |
|
|
set exp [lindex $val $j] |
72 |
|
|
if $complete { |
73 |
|
|
set got [lindex $lst $j] |
74 |
|
|
if {! [string equal $got $exp]} { |
75 |
|
|
puts "ERR $msg: rec\[$j] = $got, exp = $exp" |
76 |
|
|
puts "REC = $witht" |
77 |
|
|
exit 1 |
78 |
|
|
} |
79 |
|
|
} |
80 |
|
|
set fld [lindex $tag $j] |
81 |
|
|
set got [eval $cmd get $fld] |
82 |
|
|
set got [lindex $got 0] |
83 |
|
|
if {! [string equal $got $exp]} { |
84 |
|
|
puts "ERR $msg: tag $fld = $got, exp = $exp" |
85 |
|
|
puts "REC = $witht" |
86 |
|
|
exit 1 |
87 |
|
|
} |
88 |
|
|
} |
89 |
|
|
}] { |
90 |
|
|
global errorInfo |
91 |
|
|
puts $errorInfo |
92 |
|
|
puts "$msg: REC = $witht" |
93 |
|
|
exit 1 |
94 |
|
|
} |
95 |
|
|
} |
96 |
|
|
|
97 |
|
|
proc checkrsp {msg stb fld val} { |
98 |
|
|
checkrec "$msg" "$stb .res" "$fld" "$val" 0 |
99 |
|
|
} |
100 |
|
|
|
101 |
|
|
proc checknoerr {msg stb fld val} { |
102 |
|
|
lappend fld sid error error2 |
103 |
|
|
lappend val 0 0 0 |
104 |
|
|
checkrsp "$msg" $stb "$fld" "$val" |
105 |
|
|
} |
106 |
|
|
|
107 |
|
|
proc sendrqs {msg stb type args} { |
108 |
|
|
global db |
109 |
|
|
if [catch { |
110 |
|
|
eval $stb req type $type db $db $args |
111 |
|
|
$stb .req delete |
112 |
|
|
}] { |
113 |
|
|
global errorInfo |
114 |
|
|
puts $errorInfo |
115 |
|
|
puts "$msg: $stb sendrqs($type)" |
116 |
|
|
exit 1 |
117 |
|
|
} |
118 |
|
|
} |
119 |
|
|
|
120 |
|
|
proc puterrline {} { |
121 |
|
|
global errorInfo |
122 |
|
|
set idx [string first \n $errorInfo] |
123 |
|
|
if {0 < $idx} { |
124 |
|
|
puts [string range $errorInfo 0 [incr idx -1]] |
125 |
|
|
} { |
126 |
|
|
puts $errorInfo |
127 |
|
|
} |
128 |
|
|
} |
129 |
|
|
|
130 |
|
|
proc evalcb {tag} { |
131 |
|
|
result add $tag "a server message" |
132 |
|
|
} |
133 |
|
|
|
134 |
|
|
proc clntestdb {dbn wrn} { |
135 |
|
|
foreach ext {txt ptr oxi} { |
136 |
|
|
if [catch { |
137 |
|
|
file delete $dbn.$ext |
138 |
|
|
}] { |
139 |
|
|
if $wrn { |
140 |
|
|
puts "cannot delete $dbn.$ext" |
141 |
|
|
puterrline |
142 |
|
|
} |
143 |
|
|
} |
144 |
|
|
} |
145 |
|
|
} |
146 |
|
|
|
147 |
|
|
proc opentestdb {stb db {msg open}} { |
148 |
|
|
set fd1 [openIsisRec] |
149 |
|
|
$fd1 add 860 10 862 0 863 1 865 256 866 name 867 "" |
150 |
|
|
set fd2 [openIsisRec] |
151 |
|
|
$fd2 add 860 11 862 0 863 1 865 256 866 phone 867 "" |
152 |
|
|
set fd3 [openIsisRec] |
153 |
|
|
$fd3 add 860 12 862 0 863 1 865 256 866 title 867 "" |
154 |
|
|
set fd4 [openIsisRec] |
155 |
|
|
$fd4 add 860 13 862 0 863 1 865 256 866 street 867 "" |
156 |
|
|
set fd5 [openIsisRec] |
157 |
|
|
$fd5 add 860 20 862 0 863 1 865 256 866 city 867 "" |
158 |
|
|
set fd6 [openIsisRec] |
159 |
|
|
$fd6 add 860 88 862 0 863 1 865 256 866 summary 867 "" |
160 |
|
|
set fd61 [openIsisRec] |
161 |
|
|
$fd61 add 860 88 861 q 862 0 863 0 865 256 866 overview 867 "" |
162 |
|
|
set fdt [openIsisRec] |
163 |
|
|
$fdt add 880 7 |
164 |
|
|
$fdt wrap -done -tag 881 $fd1 |
165 |
|
|
$fdt wrap -done -tag 881 $fd2 |
166 |
|
|
$fdt wrap -done -tag 881 $fd3 |
167 |
|
|
$fdt wrap -done -tag 881 $fd4 |
168 |
|
|
$fdt wrap -done -tag 881 $fd5 |
169 |
|
|
$fdt wrap -done -tag 881 $fd6 |
170 |
|
|
$fdt wrap -done -tag 881 $fd61 |
171 |
|
|
|
172 |
|
|
set tgt [$stb .req .fdt] |
173 |
|
|
$tgt copy $fdt |
174 |
|
|
$fdt done |
175 |
|
|
|
176 |
|
|
sendrqs $msg $stb open |
177 |
|
|
checknoerr $msg $stb {db dbid} "$db 0" |
178 |
|
|
} |
179 |
|
|
|
180 |
|
|
set db testdb |
181 |
|
|
set syspath /opt/openisis/db/cds |
182 |
|
|
set nn 1 |
183 |
|
|
set mm 1 |
184 |
|
|
set debug -1 |
185 |
|
|
if {$argc} { |
186 |
|
|
set x [lindex $argv 0] |
187 |
|
|
if [string length $x] { |
188 |
|
|
set syspath $x |
189 |
|
|
} |
190 |
|
|
unset x |
191 |
|
|
if {1 < $argc} { |
192 |
|
|
set nn [lindex $argv 1] |
193 |
|
|
if {2 < $argc} { |
194 |
|
|
set mm [lindex $argv 2] |
195 |
|
|
if {3 < $argc} { |
196 |
|
|
set debug [lindex $argv 3] |
197 |
|
|
} |
198 |
|
|
} |
199 |
|
|
} |
200 |
|
|
} |
201 |
|
|
|
202 |
|
|
puts "using $syspath/$db" |
203 |
|
|
clntestdb $syspath/$db 0 |
204 |
|
|
|
205 |
|
|
for {set n $nn} {$n} {incr n -1} { |
206 |
|
|
set args "syspath $syspath" |
207 |
|
|
if ![string equal $debug -1] { |
208 |
|
|
set args "$args v $debug" |
209 |
|
|
} |
210 |
|
|
set stb [eval openIsis $args] |
211 |
|
|
|
212 |
|
|
# rqs open |
213 |
|
|
# $rec copy |
214 |
|
|
opentestdb $stb $db |
215 |
|
|
|
216 |
|
|
for {set m $mm; set hasdb 0} {$m} {incr m -1; set hasdb 1} { |
217 |
|
|
|
218 |
|
|
# rqs eval |
219 |
|
|
set rec [$stb .req .rec] |
220 |
|
|
$rec add 1 {evalcb 94} |
221 |
|
|
sendrqs eval(1) $stb eval |
222 |
|
|
checknoerr eval(1) $stb {} {} |
223 |
|
|
set rec [$stb .res .rec] |
224 |
|
|
checkrec evalres(1) $rec 94 {{a server message}} 1 |
225 |
|
|
|
226 |
|
|
# rqs ls |
227 |
|
|
sendrqs ls $stb ls |
228 |
|
|
checknoerr ls $stb db $db |
229 |
|
|
|
230 |
|
|
# fdt db ?option ...? |
231 |
|
|
set fdt [$stb fdt $db] |
232 |
|
|
checkrec fdt1 $fdt flen 7 0 |
233 |
|
|
checkrec fd11 "$fdt .fd\\\[0]" {tag type rep len name descr} \ |
234 |
|
|
{10 0 1 256 name {}} 1 |
235 |
|
|
checkrec fd12 "$fdt .fd\\\[1]" {tag type rep len name descr} \ |
236 |
|
|
{11 0 1 256 phone {}} 1 |
237 |
|
|
checkrec fd13 "$fdt .fd\\\[2]" {tag type rep len name descr} \ |
238 |
|
|
{12 0 1 256 title {}} 1 |
239 |
|
|
checkrec fd14 "$fdt .fd\\\[3]" {tag type rep len name descr} \ |
240 |
|
|
{13 0 1 256 street {}} 1 |
241 |
|
|
checkrec fd15 "$fdt .fd\\\[4]" {tag type rep len name descr} \ |
242 |
|
|
{20 0 1 256 city {}} 1 |
243 |
|
|
checkrec fd16 "$fdt .fd\\\[5]" {tag type rep len name descr} \ |
244 |
|
|
{88 0 1 256 summary {}} 1 |
245 |
|
|
checkrec fd161 "$fdt .fd\\\[6]" {tag sub type rep len name descr} \ |
246 |
|
|
{88 q 0 0 256 overview {}} 1 |
247 |
|
|
$fdt done |
248 |
|
|
checkrec fd21 "$stb fdt $db .fd\\\[0]" \ |
249 |
|
|
{tag type rep len name descr} \ |
250 |
|
|
{10 0 1 256 name ""} 1 |
251 |
|
|
checkrec fd22 "$stb fdt $db .fd\\\[1]" \ |
252 |
|
|
{tag type rep len name descr} \ |
253 |
|
|
{11 0 1 256 phone ""} 1 |
254 |
|
|
checkrec fd23 "$stb fdt $db .fd\\\[2]" \ |
255 |
|
|
{tag type rep len name descr} \ |
256 |
|
|
{12 0 1 256 title ""} 1 |
257 |
|
|
checkrec fd24 "$stb fdt $db .fd\\\[3]" \ |
258 |
|
|
{tag type rep len name descr} \ |
259 |
|
|
{13 0 1 256 street ""} 1 |
260 |
|
|
checkrec fd25 "$stb fdt $db .fd\\\[4]" \ |
261 |
|
|
{tag type rep len name descr} \ |
262 |
|
|
{20 0 1 256 city ""} 1 |
263 |
|
|
checkrec fd26 "$stb fdt $db .fd\\\[5]" \ |
264 |
|
|
{tag type rep len name descr} \ |
265 |
|
|
{88 0 1 256 summary ""} 1 |
266 |
|
|
checkrec fd261 "$stb fdt $db .fd\\\[6]" \ |
267 |
|
|
{tag sub type rep len name descr} \ |
268 |
|
|
{88 q 0 0 256 overview ""} 1 |
269 |
|
|
|
270 |
|
|
checkrec fdsys "$stb fdt -sys .fd\\\[0]" \ |
271 |
|
|
{tag name} {5 syspath} 0 |
272 |
|
|
checkrec fdsch "$stb fdt -sche .fd\\\[0]" \ |
273 |
|
|
{tag name} {710 name} 0 |
274 |
|
|
checkrec fdsch "$stb fdt -sche .fd\\\[1]" \ |
275 |
|
|
{tag name} {711 host} 0 |
276 |
|
|
checkrec fddb "$stb fdt -db .fd\\\[0]" \ |
277 |
|
|
{tag name} {800 db} 0 |
278 |
|
|
checkrec fdfd "$stb fdt -fd .fd\\\[0]" \ |
279 |
|
|
{tag name} {860 tag} 0 |
280 |
|
|
checkrec fdfd "$stb fdt -fdt .fd\\\[0]" \ |
281 |
|
|
{tag name} {880 flen} 0 |
282 |
|
|
checkrec fdrqs0 "$stb fdt -req .fd\\\[0]" \ |
283 |
|
|
{tag name} {900 sid} 0 |
284 |
|
|
checkrec fdrqs10 "$stb fdt -req .fd\\\[10]" \ |
285 |
|
|
{tag name} {920 type} 0 |
286 |
|
|
checkrec fdrsp0 "$stb fdt -res .fd\\\[0]" \ |
287 |
|
|
{tag name} {900 sid} 0 |
288 |
|
|
checkrec fdrsp10 "$stb fdt -res .fd\\\[10]" \ |
289 |
|
|
{tag name} {940 dbid} 0 |
290 |
|
|
|
291 |
|
|
# db db ?option ...? |
292 |
|
|
set rec [$stb db $db] |
293 |
|
|
checkrec meta $rec {800 803} "$db $syspath" 0 |
294 |
|
|
rename $rec "" |
295 |
|
|
if [catch {$rec get}] {} { |
296 |
|
|
puts "ERR meta: $rec still present" |
297 |
|
|
exit 1 |
298 |
|
|
} |
299 |
|
|
|
300 |
|
|
# new -schema name ?-cfg val ...? |
301 |
|
|
set rec [$stb new -sche testsrv -host localhost -port 3434] |
302 |
|
|
checkrec schema $rec {711 712} {localhost 3434} 0 |
303 |
|
|
rename $rec "" |
304 |
|
|
set rec [$stb new -sche testsrv -host localhost -port 3434] |
305 |
|
|
checkrec schema $rec {711 712} {localhost 3434} 0 |
306 |
|
|
$rec done |
307 |
|
|
|
308 |
|
|
# new ?-db db? ?name? |
309 |
|
|
# $rec db |
310 |
|
|
# $rec fdt |
311 |
|
|
if [catch {set rec [$stb new]}] {} { |
312 |
|
|
puts "ERR newrec1 = $rec" |
313 |
|
|
exit 1 |
314 |
|
|
} |
315 |
|
|
set rec [$stb new -db $db] |
316 |
|
|
checkrec recfdt1 "$rec fdt .fd\\\[1]" \ |
317 |
|
|
{tag name} {11 phone} 0 |
318 |
|
|
if [catch { |
319 |
|
|
set dbn [$rec db get db] |
320 |
|
|
if ![string equal $dbn $db] { |
321 |
|
|
puts "ERR recdb = $dbn" |
322 |
|
|
exit 1 |
323 |
|
|
} |
324 |
|
|
}] { |
325 |
|
|
global errorInfo |
326 |
|
|
puts $errorInfo |
327 |
|
|
puts "recdb failed" |
328 |
|
|
exit 1 |
329 |
|
|
} |
330 |
|
|
set rec [$stb new -db -sys $rec] |
331 |
|
|
checkrec recfdt2 "$rec fdt .fd\\\[1]" \ |
332 |
|
|
{tag name} {700 logfile} 0 |
333 |
|
|
set rec [$rec clone $rec] |
334 |
|
|
checkrec recfdt3 "$rec fdt .fd\\\[1]" \ |
335 |
|
|
{tag name} {700 logfile} 0 |
336 |
|
|
set dbn "" |
337 |
|
|
if [catch {set dbn [$rec db get]}] {} { |
338 |
|
|
puts "ERR recdb = $dbn" |
339 |
|
|
exit 1 |
340 |
|
|
} |
341 |
|
|
$stb add defaultdb $db |
342 |
|
|
if [catch {set rec [$stb new $rec]}] { |
343 |
|
|
global errorInfo |
344 |
|
|
puts $errorInfo |
345 |
|
|
puts "newrec2 failed" |
346 |
|
|
exit 1 |
347 |
|
|
} |
348 |
|
|
checkrec recfdt4 "$rec fdt .fd\\\[1]" \ |
349 |
|
|
{tag name} {11 phone} 0 |
350 |
|
|
$stb del defaultdb |
351 |
|
|
$rec done |
352 |
|
|
set rec [$stb clone] |
353 |
|
|
checkrec recfdt5 $rec syspath $syspath 0 |
354 |
|
|
checkrec recfdt6 "$rec fdt .fd\\\[0]" \ |
355 |
|
|
{tag name} {5 syspath} 0 |
356 |
|
|
$rec done |
357 |
|
|
|
358 |
|
|
# rqs insert |
359 |
|
|
if !$hasdb { |
360 |
|
|
set rec [$stb .req -db $db .rec] |
361 |
|
|
set idx [$stb .req .idx] |
362 |
|
|
$rec add name harry phone 4711 city montevideo |
363 |
|
|
# XDOT [[dbn.]mfn.]tag.occ.pos or tag[.occ] |
364 |
|
|
$idx add 10 harry 10 hurry |
365 |
|
|
sendrqs insert1 $stb insert |
366 |
|
|
checknoerr insert1 $stb {db rowid} "$db 1" |
367 |
|
|
set row 1 |
368 |
|
|
} |
369 |
|
|
if {1000 > $row} { |
370 |
|
|
set rec [$stb .req -db $db .rec] |
371 |
|
|
set idx [$stb .req .idx] |
372 |
|
|
set phone "+4711" |
373 |
|
|
$rec add name mary phone $phone summary {Meeting Implementation} |
374 |
|
|
$idx add 11 $phone 11 marry |
375 |
|
|
sendrqs insert2 $stb insert |
376 |
|
|
checknoerr insert2 $stb {} {} |
377 |
|
|
set row2 [$stb .res get rowid] |
378 |
|
|
if {[incr row] != $row2} { |
379 |
|
|
puts "ERR insert2: rowid == $row2, exp = $row" |
380 |
|
|
exit 1 |
381 |
|
|
} |
382 |
|
|
} |
383 |
|
|
|
384 |
|
|
# rqs maxrow |
385 |
|
|
sendrqs maxrow1 $stb maxrow |
386 |
|
|
checknoerr maxrow1 $stb rowid $row |
387 |
|
|
|
388 |
|
|
# .req ?-db db? ?option ...? |
389 |
|
|
# rqs update |
390 |
|
|
set phone "+49-30-$row" |
391 |
|
|
set rec [$stb .req -db $db .rec] |
392 |
|
|
$rec add name lary phone $phone street chausseestr |
393 |
|
|
$stb .req -db $db set rowid $row |
394 |
|
|
sendrqs update1 $stb update rowid $row |
395 |
|
|
checknoerr update1 $stb rowid $row |
396 |
|
|
set idx [$stb .req .idx] |
397 |
|
|
$idx add -3 "-11.1\tmarry" |
398 |
|
|
sendrqs update2 $stb update rowid $row |
399 |
|
|
checknoerr update2 $stb rowid $row |
400 |
|
|
set idx [$stb .req .idx] |
401 |
|
|
$idx add -3 "11\tlary" |
402 |
|
|
sendrqs update3 $stb update rowid $row |
403 |
|
|
checknoerr update3 $stb rowid $row |
404 |
|
|
|
405 |
|
|
# rqs maxrow |
406 |
|
|
sendrqs maxrow2 $stb maxrow |
407 |
|
|
checknoerr maxrow2 $stb rowid $row |
408 |
|
|
|
409 |
|
|
# recv |
410 |
|
|
if [catch { |
411 |
|
|
$stb recv |
412 |
|
|
if ![$stb .res] { |
413 |
|
|
puts "ERR: .res == 0" |
414 |
|
|
exit 1 |
415 |
|
|
} |
416 |
|
|
}] { |
417 |
|
|
global errorInfo |
418 |
|
|
puts $errorInfo |
419 |
|
|
puts "recv failed" |
420 |
|
|
exit 1 |
421 |
|
|
} |
422 |
|
|
|
423 |
|
|
# rqs read (row 1) |
424 |
|
|
$stb .req set rowid 1 |
425 |
|
|
sendrqs read1 $stb read |
426 |
|
|
checknoerr read1 $stb {total size rowid} "1 1 1" |
427 |
|
|
# checknoerr read1 $stb "" "" |
428 |
|
|
set rec [$stb .res .rec] |
429 |
|
|
checkrec read1/fdt "$rec fdt .fd\\\[1]" \ |
430 |
|
|
{tag name} {11 phone} 0 |
431 |
|
|
if [catch { |
432 |
|
|
set dbn [$rec db get db] |
433 |
|
|
if ![string equal $dbn $db] { |
434 |
|
|
puts "ERR read1/recdb = $dbn" |
435 |
|
|
exit 1 |
436 |
|
|
} |
437 |
|
|
}] { |
438 |
|
|
global errorInfo |
439 |
|
|
puts $errorInfo |
440 |
|
|
puts "read1/recdb failed" |
441 |
|
|
exit 1 |
442 |
|
|
} |
443 |
|
|
checkrec read1 $rec {name phone city} {harry 4711 montevideo} 1 |
444 |
|
|
$rec done |
445 |
|
|
|
446 |
|
|
# rqs eval |
447 |
|
|
set rec [$stb .req .rec] |
448 |
|
|
$rec add 1 {evalcb 229} |
449 |
|
|
sendrqs eval(2) $stb eval |
450 |
|
|
checknoerr eval(2) $stb {} {} |
451 |
|
|
set rec [$stb .res .rec] |
452 |
|
|
checkrec evalres(2) $rec 229 {{a server message}} 1 |
453 |
|
|
|
454 |
|
|
# rqs read (row n) |
455 |
|
|
for {set r 2} {$row >= $r} {incr r} { |
456 |
|
|
set msg "read($r)" |
457 |
|
|
$stb .req set rowid $r |
458 |
|
|
sendrqs $msg $stb read |
459 |
|
|
checknoerr $msg $stb {total size rowid} "1 1 $r" |
460 |
|
|
set rec [$stb .res .rec] |
461 |
|
|
checkrec $msg/fdt "$rec fdt .fd\\\[1]" \ |
462 |
|
|
{tag name} {11 phone} 0 |
463 |
|
|
if [catch { |
464 |
|
|
set dbn [$rec db get db] |
465 |
|
|
if ![string equal $dbn $db] { |
466 |
|
|
puts "ERR $msg/recdb = $dbn" |
467 |
|
|
exit 1 |
468 |
|
|
} |
469 |
|
|
}] { |
470 |
|
|
global errorInfo |
471 |
|
|
puts $errorInfo |
472 |
|
|
puts "$msg/recdb failed" |
473 |
|
|
exit 1 |
474 |
|
|
} |
475 |
|
|
set phone "+49-30-$r" |
476 |
|
|
checkrec $msg $rec {name phone street} "lary $phone chausseestr" 1 |
477 |
|
|
set rec2 [$rec clone] |
478 |
|
|
set rero [$rec2 row] |
479 |
|
|
$rec2 done |
480 |
|
|
if {$rero != $r} { |
481 |
|
|
puts "ERR $msg: rowid = $rero, exp: $r" |
482 |
|
|
exit 1 |
483 |
|
|
} |
484 |
|
|
if {2 == $r} { |
485 |
|
|
set got [$rec get -tag] |
486 |
|
|
checklst gettags \ |
487 |
|
|
"10 lary 11 $phone 13 chausseestr" $got |
488 |
|
|
set got [$rec get -tagn] |
489 |
|
|
checklst gettagn \ |
490 |
|
|
"name lary phone $phone street chausseestr" $got |
491 |
|
|
} |
492 |
|
|
} |
493 |
|
|
|
494 |
|
|
# rqs query |
495 |
|
|
set tot [expr $row - 1] |
496 |
|
|
set siz 100 |
497 |
|
|
if {100 >= $row} { |
498 |
|
|
set siz $tot |
499 |
|
|
} |
500 |
|
|
$stb .req set typ query key marr size 100 flags 2 |
501 |
|
|
$stb req mode 1 |
502 |
|
|
checknoerr query $stb {total size} "$tot $siz" |
503 |
|
|
for {set j 0} {$siz > $j} {incr j} { |
504 |
|
|
set r [$stb .res get rowid\[$j\]] |
505 |
|
|
set phone "+49-30-$r" |
506 |
|
|
set rec [$stb .res .rec\[$j\]] |
507 |
|
|
checkrec "query\[$j]" $rec {name phone street} \ |
508 |
|
|
"lary $phone chausseestr" 1 |
509 |
|
|
set rero [$rec row] |
510 |
|
|
if {$rero != $r} { |
511 |
|
|
puts "ERR query\[$j]: rowid = $rero, exp: $r" |
512 |
|
|
exit 1 |
513 |
|
|
} |
514 |
|
|
} |
515 |
|
|
|
516 |
|
|
if ![expr $m % 100] { |
517 |
|
|
puts "$n $m ($row) ..." |
518 |
|
|
} |
519 |
|
|
} |
520 |
|
|
|
521 |
|
|
# rqs close |
522 |
|
|
sendrqs close $stb close |
523 |
|
|
checknoerr close $stb db $db |
524 |
|
|
clntestdb $syspath/$db 1 |
525 |
|
|
|
526 |
|
|
# rqs eval |
527 |
|
|
set rec [$stb .req .rec] |
528 |
|
|
$rec add 1 {evalcb 147} |
529 |
|
|
sendrqs eval(3) $stb eval |
530 |
|
|
checknoerr eval(3) $stb {} {} |
531 |
|
|
set rec [$stb .res .rec] |
532 |
|
|
checkrec evalres(3) $rec 147 {{a server message}} 1 |
533 |
|
|
|
534 |
|
|
if {100 > $mm && ! [expr $n % 100]} { |
535 |
|
|
puts "$n ..." |
536 |
|
|
} |
537 |
|
|
|
538 |
|
|
# done |
539 |
|
|
$stb done |
540 |
|
|
if [catch {$stb get}] {} { |
541 |
|
|
puts "ERR done" |
542 |
|
|
exit 1 |
543 |
|
|
} |
544 |
|
|
} |
545 |
|
|
|
546 |
|
|
puts "ok." |
547 |
|
|
|