1 |
#!/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 |
|