tcl/test/testcli.tcl

#!/opt/openisis/tcl/bin/isish
#
#       openisis - an open implementation of the ISIS database
#       Version 0.8.x (microversion see file Version)
#       Copyright (C) 2003 by Erik Grziwotz, erik@openisis.org
#
#       This library is free software; you can redistribute it and/or
#       modify it under the terms of the GNU Lesser General Public
#       License as published by the Free Software Foundation; either
#       version 2.1 of the License, or (at your option) any later version.
#
#       This library is distributed in the hope that it will be useful,
#       but WITHOUT ANY WARRANTY; without even the implied warranty of
#       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#       Lesser General Public License for more details.
#
#       You should have received a copy of the GNU Lesser General Public
#       License along with this library; if not, write to the Free Software
#       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#       This software is dedicated to the memory of Eckart Dietrich.
#
#       This software is inspired by (but contains no code of) the iAPI
#       Copyright (C) 2000 by Robert Janusz, rj@jezuici.krakow.pl.
#       See iAPI.txt for what it contains.
#
#       $Id: testcli.tcl,v 1.4 2003/06/15 15:57:44 mawag Exp $
#       test script for db servers client

proc checklst {msg exp got} {
        if [catch {
                set len1 [llength $exp]
                set len2 [llength $got]
                if {$len1 != $len2} {
                        puts "ERR $msg: length != $len1"
                        puts "REC = $got"
                        exit 1
                }
                for {set j 0} {$len1 > $j} {incr j} {
                        set gg [lindex $got $j]
                        set ee [lindex $exp $j]
                        if {! [string equal $gg $ee]} {
                                puts "ERR $msg: got\[$j] = $gg, exp = $ee"
                                puts "REC = $got"
                                exit 1
                        }
                }
        }] {
                global errorInfo
                puts $errorInfo
                puts "REC = $got"
                exit 1
        }
}

proc checkrec {msg cmd tag val {complete 0}} {
        set lst ""
        set witht ""
        if [catch {
                set lst [eval $cmd get]
                set witht [eval $cmd get -tags]
                set len [llength $val]
                if $complete {
                        if {[llength $lst] != $len} {
                                puts "ERR $msg: got len = [llength $lst], exp = $len"
                                puts "REC = $witht"
                                exit 1
                        }
                }
                for {set j 0} {$len > $j} {incr j} {
                        set exp [lindex $val $j]
                        if $complete {
                                set got [lindex $lst $j]
                                if {! [string equal $got $exp]} {
                                        puts "ERR $msg: rec\[$j] = $got, exp = $exp"
                                        puts "REC = $witht"
                                        exit 1
                                }
                        }
                        set fld [lindex $tag $j]
                        set got [eval $cmd get $fld]
                        set got [lindex $got 0]
                        if {! [string equal $got $exp]} {
                                puts "ERR $msg: tag $fld = $got, exp = $exp"
                                puts "REC = $witht"
                                exit 1
                        }
                }
        }] {
                global errorInfo
                puts $errorInfo
                puts "$msg: REC = $witht"
                exit 1
        }
}

proc checkrsp {msg stb fld val} {
        checkrec "$msg" "$stb .res" "$fld" "$val"
}

proc checknoerr {msg stb fld val} {
        lappend fld sid error error2
        lappend val [expr 1 << 8] 0 0
        checkrsp "$msg" $stb "$fld" "$val"
}

proc sendrqs {msg stb type db args} {
        if [string length $db] {
                set db "db $db"
        }
        if [catch {
                eval $stb req type $type $db $args
                $stb .req delete
        }] {
                global errorInfo
                puts $errorInfo
                puts "$msg: $stb sendrqs($type)"
                exit 1
        }
}

#       -----------------------------------------------------------------

if [catch {
        set nn [lindex $argv 0]
        incr nn 0
}] {
        set nn 1
}
if [catch {
        set dbg "v [lindex $argv 1]"
}] {
        set dbg ""
}
set verbose [expr 1 == $nn && [string length $dbg]]

set stb0 [eval openIsis $dbg]

set stb1 [$stb0 new -schema tstsrv -host localhost -port 8080]

for {set n $nn} {0 != $n} {incr n -1} {

        sendrqs RQS_LS $stb1 ls ""
        checknoerr RSP_LS $stb1 "" ""
        set dbs [$stb1 .res get db]
        foreach db $dbs {
                if {$verbose} {
                        puts "tstsrv has $db"
                }
        }
        set db cds
        if {0 > [lsearch -exact $dbs $db]} {
                puts "ERR expected cds db for testing"
                exit 1
        }

        sendrqs RQS_MOUNT $stb1 mount $db
        checknoerr RSP_MOUNT $stb1 "" ""
        set fdt [$stb1 fdt $db]
        checkrec FDT $fdt {881 {866\[0\]}} {6 conference_main_entry}
        if {$verbose} {
                puts [$fdt seri]
        }
        $fdt done

        set maxrow 154
        sendrqs RQS_MAXROW $stb1 maxrow $db
        checknoerr RSP_MAXROW $stb1 904 $maxrow

        for {set r 1} {$maxrow >= $r} {incr r} {
                sendrqs RQS_READ($r) $stb1 read $db rowid $r
                if {23 == $r || 152 <= $r} {
                        set exp "0 0"
                        set fld "total size"
                } {
                        set exp "1 1 $r"
                        set fld "total size rowid"
                }
                checknoerr RSP_READ($r) $stb1 $fld $exp
        }

        $stb1 .req .rec add 42 "evalcb $n"
        sendrqs RQS_EVAL $stb1 eval {}
        checknoerr RSP_EVAL $stb1 {total size row} {1 1 0}
        set rec [$stb1 .res .rec]
        checkrec REC_EVAL $rec $n tach 1

        sendrqs RQS_QUERY $stb1 query $db key africa\$ mode 2 flags 2
        checknoerr RSP_QUERY $stb1 {total size} {5 5}
        if $verbose {
                for {set i 0} {5 > $i} {incr i} {
                        set ttl ""
                        catch { set ttl [$stb1 .res .rec\[$i\] get 24] }
                        if {60 < [string length $ttl]} {
                                set ttl "[string range $ttl 0 57] ..."
                        }
                        puts "rec($i) [$stb1 .res get row\[$i\]]: $ttl"
                }
        }

        if {0 == [expr $n % 20]} {
                puts "$n ..."
        }
}

$stb1 done
puts ok.
exit 0

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: testcli.tcl,v 1.4 2003/06/15 15:57:44 mawag Exp $
28			# test script for db servers client
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 0}} {
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"
99			}
100
101			proc checknoerr {msg stb fld val} {
102			lappend fld sid error error2
103			lappend val [expr 1 << 8] 0 0
104			checkrsp "$msg" $stb "$fld" "$val"
105			}
106
107			proc sendrqs {msg stb type db args} {
108			if [string length $db] {
109			set db "db $db"
110			}
111			if [catch {
112			eval $stb req type $type $db $args
113			$stb .req delete
114			}] {
115			global errorInfo
116			puts $errorInfo
117			puts "$msg: $stb sendrqs($type)"
118			exit 1
119			}
120			}
121
122			# -----------------------------------------------------------------
123
124			if [catch {
125			set nn [lindex $argv 0]
126			incr nn 0
127			}] {
128			set nn 1
129			}
130			if [catch {
131			set dbg "v [lindex $argv 1]"
132			}] {
133			set dbg ""
134			}
135			set verbose [expr 1 == $nn && [string length $dbg]]
136
137			set stb0 [eval openIsis $dbg]
138
139			set stb1 [$stb0 new -schema tstsrv -host localhost -port 8080]
140
141			for {set n $nn} {0 != $n} {incr n -1} {
142
143			sendrqs RQS_LS $stb1 ls ""
144			checknoerr RSP_LS $stb1 "" ""
145			set dbs [$stb1 .res get db]
146			foreach db $dbs {
147			if {$verbose} {
148			puts "tstsrv has $db"
149			}
150			}
151			set db cds
152			if {0 > [lsearch -exact $dbs $db]} {
153			puts "ERR expected cds db for testing"
154			exit 1
155			}
156
157			sendrqs RQS_MOUNT $stb1 mount $db
158			checknoerr RSP_MOUNT $stb1 "" ""
159			set fdt [$stb1 fdt $db]
160			checkrec FDT $fdt {881 {866\[0\]}} {6 conference_main_entry}
161			if {$verbose} {
162			puts [$fdt seri]
163			}
164			$fdt done
165
166			set maxrow 154
167			sendrqs RQS_MAXROW $stb1 maxrow $db
168			checknoerr RSP_MAXROW $stb1 904 $maxrow
169
170			for {set r 1} {$maxrow >= $r} {incr r} {
171			sendrqs RQS_READ($r) $stb1 read $db rowid $r
172			if {23 == $r \|\| 152 <= $r} {
173			set exp "0 0"
174			set fld "total size"
175			} {
176			set exp "1 1 $r"
177			set fld "total size rowid"
178			}
179			checknoerr RSP_READ($r) $stb1 $fld $exp
180			}
181
182			$stb1 .req .rec add 42 "evalcb $n"
183			sendrqs RQS_EVAL $stb1 eval {}
184			checknoerr RSP_EVAL $stb1 {total size row} {1 1 0}
185			set rec [$stb1 .res .rec]
186			checkrec REC_EVAL $rec $n tach 1
187
188			sendrqs RQS_QUERY $stb1 query $db key africa\$ mode 2 flags 2
189			checknoerr RSP_QUERY $stb1 {total size} {5 5}
190			if $verbose {
191			for {set i 0} {5 > $i} {incr i} {
192			set ttl ""
193			catch { set ttl [$stb1 .res .rec\[$i\] get 24] }
194			if {60 < [string length $ttl]} {
195			set ttl "[string range $ttl 0 57] ..."
196			}
197			puts "rec($i) [$stb1 .res get row\[$i\]]: $ttl"
198			}
199			}
200
201			if {0 == [expr $n % 20]} {
202			puts "$n ..."
203			}
204			}
205
206			$stb1 done
207			puts ok.
208			exit 0
209