tcl/test/testrec.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: testrec.tcl,v 1.9 2003/06/24 10:54:32 mawag Exp $
#       test script for record commands

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} {
        set lst ""
        set tlst ""
        if [catch {
                set lst [$cmd get]
                set tlst [$cmd get -tags]
                set len [llength $val]
                if {[llength $lst] != $len} {
                        puts "ERR $msg: got len = [llength $lst], exp = $len"
                        puts "REC = $tlst"
                        exit 1
                }
                for {set j 0} {$len > $j} {incr j} {
                        set got [lindex $lst $j]
                        set exp [lindex $val $j]
                        if {! [string equal $got $exp]} {
                                puts "ERR $msg: rec\[$j] = $got, exp = $exp"
                                puts "REC = $tlst"
                                exit 1
                        }
                        set fld [lindex $tag $j]
                        set got [$cmd get $fld]
                        if {! [string equal $got $exp]} {
                                puts "ERR $msg: tag $fld = $got, exp = $exp"
                                puts "REC = $tlst"
                                exit 1
                        }
                }
        }] {
                global errorInfo
                puts $errorInfo
                puts "REC = $tlst"
                exit 1
        }
}

set nn 1
set mm 1
switch $argc {
0 {}
1 { set nn [lindex $argv 0] }
default { set nn [lindex $argv 0]; set mm [lindex $argv 1] }
}

for {set n $nn} {0 != $n} {incr n -1} {
#       -fdt option
        set fd [openIsisRec {} add 860 1 862 0 866 name 867 desc]
        set fdt [openIsisRec {} wrap -done -tag 881 $fd]
        $fdt add 880 1
        set cmd [openIsisRec -fdt $fdt]
        set len [$cmd fdt get 880]
        if {1 != $len} {
                puts "ERR fdt len = $len"
                puts "FDT = [$cmd fdt get -tags]"
                exit 1
        }
        set fd2 [$cmd fdt .881]
        checkrec fd $fd2 {860 862 863 865 866 867} {1 0 0 0 name desc}
        $fd2 done
        $fdt done
        $cmd done

        set cmd [openIsisRec]
        checkrec "ctor1" $cmd {} {}
        for {set m $mm} {0 != $m} {incr m -1} {

#               add field value ?field value ...?
                $cmd add 11 22
                checkrec add1 $cmd 11 22
                $cmd add 33 44 55 66 77 88
                checkrec add2 $cmd {11 33 55 77} {22 44 66 88}
                $cmd add 33 333 77 777 33 3333
                checkrec add3 $cmd {11 33\[0] 55 77\[0] 33\[1] 77\[1] 33\[2]} \
                        {22 44 66 88 333 777 3333}

#               clone ?options? newname ?field value ...?
                set clone [$cmd clone]
                checkrec clone1 $clone {11 33\[0] 55 77\[0] 33\[1] 77\[1] 33\[2]} \
                        {22 44 66 88 333 777 3333}
                $clone done
                set clone [$cmd clone -empty]
                checkrec clone2 $clone {} {}
                $clone done
                set clone [$cmd clone - 99 999 77\[1\] 7171]
                if [string compare -length 11 $clone openIsisRec] {
                        puts "ERR clone3: recname = $clone"
                        exit 1
                }
                checkrec clone3 $clone {11 33\[0] 55 77\[0] 33\[1] 77\[1] 33\[2] 99} \
                        {22 44 66 88 333 7171 3333 999}
                $clone done
                set clone [$cmd clone -empty bla 99 999 77\[0\] 7171]
                if ![string equal $clone bla] {
                        puts "ERR clone4: recname = $clone"
                        exit 1
                }
                checkrec clone4 $clone {99 77} {999 7171}
                $clone done

#               copy source
#               db ?options?
#               fdt ?options?
#               see teststb.tcl

#               delete ?field ...?
                $cmd dele 77\[0] 33\[1]
                checkrec del1 $cmd {11 33\[0] 55 77 33\[1]} \
                        {22 44 66 777 3333}
                $cmd delete
                checkrec del2 $cmd {} {}

                $cmd add 11 22 33 44 55 66 33 333 33 3333 11 111
                checkrec add4 $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1]} \
                        {22 44 66 333 3333 111}

#               deserialize line, serialize
                set ser [$cmd seri]
                $cmd dele
                checkrec del3 $cmd {} {}
                $cmd deser $ser
                checkrec deser $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1]} \
                        {22 44 66 333 3333 111}

#               do ?tagvar? valvar body
                $cmd do t v {
                        set t1 [string range $t 0 1]
                        if {11 == $t1 || 55 == $t1} {
                                $cmd add $t1 $v$v
                        }
                }
                checkrec do $cmd {11\[0] 33\[0] 55\[0] 33\[1] 33\[2] 11\[1]
                        11\[2] 55\[1] 11\[3]} \
                        {22 44 66 333 3333 111 2222 6666 111111}

#               get ?field ...?
                set third [$cmd get 33]
                if ![string equal {44 333 3333} "$third"] {
                        puts "ERR get1: rec\[33] = $third"
                        exit 1
                }
                set got [$cmd get {888 8181}]
                if ![string equal 8181 $got] {
                        puts "ERR getdflt: rec\[888] = $got"
                        exit 1
                }
                set got [$cmd get]
                checklst get2 {22 44 66 333 3333 111 2222 6666 111111} $got
                set got [$cmd get -tag]
                checklst get3 {
                        11 22
                        33 44
                        55 66
                        33 333
                        33 3333
                        11 111
                        11 2222
                        55 6666
                        11 111111
                } $got

#               set field ?value field value ...?
                $cmd set 55 5555 77 88 33\[1] 3131
                checkrec set $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1]
                        11\[2] 11\[3] 77} \
                        {22 44 5555 3131 3333 111 2222 111111 88}

#               wrap ?options? recname
                set emb [openIsisRec emb set 111 aaa 112 bbb 111 ccc]
                if ![string equal $emb emb] {
                        puts "ERR emb: recname = $emb"
                        exit 1
                }
                checkrec ctor2 $emb {111\[0] 112 111\[1]} {aaa bbb ccc}
                $cmd wrap -tag 999 $emb
                checkrec wrap1 $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1]
                        11\[2] 11\[3] 77 999 111\[0] 112 111\[1]} \
                        {22 44 5555 3131 3333 111 2222 111111 88 3 aaa bbb ccc}
                $cmd wrap -tag 888 -num 42 $emb
                checkrec wrap2 $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1]
                        11\[2] 11\[3] 77 999 111\[0] 112\[0] 111\[1] 888
                        111\[2] 112\[1] 111\[3]} {22 44 5555 3131 3333 111 2222 111111 88
                        3 aaa bbb ccc 42 aaa bbb ccc}
                $emb set 112 ddd
                $cmd wrap -done -tag 999 $emb
                checkrec wrap3 $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1] 11\[2]
                        11\[3] 77 999\[0] 111\[0] 112\[0] 111\[1] 888 111\[2] 112\[1]
                        111\[3] 999\[1] 111\[4] 112\[2] 111\[5]} {
                        22 44 5555 3131 3333 111 2222 111111 88
                        3 aaa bbb ccc 42 aaa bbb ccc 3 aaa ddd ccc}
                if [catch {$emb get}] {} {
                        puts "ERR done1"
                        exit 1
                }

#               .path ?option arg ...?
                set emb [$cmd .999]
                checkrec path1 $emb {111\[0] 112 111\[1]} {aaa bbb ccc}
                $emb done
                set emb [$cmd .999\[1\]]
                checkrec path2 $emb {111\[0] 112 111\[1]} {aaa ddd ccc}
                $emb done
                set emb [$cmd .999\[1\] get 112]
                if ![string equal ddd $emb] {
                        puts "ERR path2: got = $emb"
                        exit 1
                }
                $cmd .999\[1\] do t v { set x $v }
                $cmd .999\[1\] add 42 43 44 45
                set emb [$cmd .999\[1\] clone emb]
                if ![string equal $emb emb] {
                        puts "ERR path3: recname = $emb"
                        exit 1
                }
                checkrec path3 $emb {111\[0] 112 111\[1]} {aaa ddd ccc}
                $emb done

                if {! [expr $m % 1000]} {
                        puts "$n $m ..."
                }
                $cmd dele

#               large argc
                set tag [list]
                set val [list]
                for {set j 0} {529 >= $j} {incr j} {
                        $cmd add 433 blabla$j
                        lappend tag 433\[$j]
                        lappend val blabla$j
                }
                set cmd2 [openIsisRec]
                eval $cmd2 add [$cmd get -tags]
                checkrec argc $cmd2 $tag $val
                $cmd dele
                $cmd2 done
                unset tag val
        }

#       done
        $cmd done
        if [catch {$cmd get}] {} {
                puts "ERR done2"
                exit 1
        }

        if {1000 > $mm && ! [expr $n % 1000]} {
                puts "$n ..."
        }
}

puts "ok."

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: testrec.tcl,v 1.9 2003/06/24 10:54:32 mawag Exp $
28			# test script for record 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} {
57			set lst ""
58			set tlst ""
59			if [catch {
60			set lst [$cmd get]
61			set tlst [$cmd get -tags]
62			set len [llength $val]
63			if {[llength $lst] != $len} {
64			puts "ERR $msg: got len = [llength $lst], exp = $len"
65			puts "REC = $tlst"
66			exit 1
67			}
68			for {set j 0} {$len > $j} {incr j} {
69			set got [lindex $lst $j]
70			set exp [lindex $val $j]
71			if {! [string equal $got $exp]} {
72			puts "ERR $msg: rec\[$j] = $got, exp = $exp"
73			puts "REC = $tlst"
74			exit 1
75			}
76			set fld [lindex $tag $j]
77			set got [$cmd get $fld]
78			if {! [string equal $got $exp]} {
79			puts "ERR $msg: tag $fld = $got, exp = $exp"
80			puts "REC = $tlst"
81			exit 1
82			}
83			}
84			}] {
85			global errorInfo
86			puts $errorInfo
87			puts "REC = $tlst"
88			exit 1
89			}
90			}
91
92			set nn 1
93			set mm 1
94			switch $argc {
95			0 {}
96			1 { set nn [lindex $argv 0] }
97			default { set nn [lindex $argv 0]; set mm [lindex $argv 1] }
98			}
99
100			for {set n $nn} {0 != $n} {incr n -1} {
101			# -fdt option
102			set fd [openIsisRec {} add 860 1 862 0 866 name 867 desc]
103			set fdt [openIsisRec {} wrap -done -tag 881 $fd]
104			$fdt add 880 1
105			set cmd [openIsisRec -fdt $fdt]
106			set len [$cmd fdt get 880]
107			if {1 != $len} {
108			puts "ERR fdt len = $len"
109			puts "FDT = [$cmd fdt get -tags]"
110			exit 1
111			}
112			set fd2 [$cmd fdt .881]
113			checkrec fd $fd2 {860 862 863 865 866 867} {1 0 0 0 name desc}
114			$fd2 done
115			$fdt done
116			$cmd done
117
118			set cmd [openIsisRec]
119			checkrec "ctor1" $cmd {} {}
120			for {set m $mm} {0 != $m} {incr m -1} {
121
122			# add field value ?field value ...?
123			$cmd add 11 22
124			checkrec add1 $cmd 11 22
125			$cmd add 33 44 55 66 77 88
126			checkrec add2 $cmd {11 33 55 77} {22 44 66 88}
127			$cmd add 33 333 77 777 33 3333
128			checkrec add3 $cmd {11 33\[0] 55 77\[0] 33\[1] 77\[1] 33\[2]} \
129			{22 44 66 88 333 777 3333}
130
131			# clone ?options? newname ?field value ...?
132			set clone [$cmd clone]
133			checkrec clone1 $clone {11 33\[0] 55 77\[0] 33\[1] 77\[1] 33\[2]} \
134			{22 44 66 88 333 777 3333}
135			$clone done
136			set clone [$cmd clone -empty]
137			checkrec clone2 $clone {} {}
138			$clone done
139			set clone [$cmd clone - 99 999 77\[1\] 7171]
140			if [string compare -length 11 $clone openIsisRec] {
141			puts "ERR clone3: recname = $clone"
142			exit 1
143			}
144			checkrec clone3 $clone {11 33\[0] 55 77\[0] 33\[1] 77\[1] 33\[2] 99} \
145			{22 44 66 88 333 7171 3333 999}
146			$clone done
147			set clone [$cmd clone -empty bla 99 999 77\[0\] 7171]
148			if ![string equal $clone bla] {
149			puts "ERR clone4: recname = $clone"
150			exit 1
151			}
152			checkrec clone4 $clone {99 77} {999 7171}
153			$clone done
154
155			# copy source
156			# db ?options?
157			# fdt ?options?
158			# see teststb.tcl
159
160			# delete ?field ...?
161			$cmd dele 77\[0] 33\[1]
162			checkrec del1 $cmd {11 33\[0] 55 77 33\[1]} \
163			{22 44 66 777 3333}
164			$cmd delete
165			checkrec del2 $cmd {} {}
166
167			$cmd add 11 22 33 44 55 66 33 333 33 3333 11 111
168			checkrec add4 $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1]} \
169			{22 44 66 333 3333 111}
170
171			# deserialize line, serialize
172			set ser [$cmd seri]
173			$cmd dele
174			checkrec del3 $cmd {} {}
175			$cmd deser $ser
176			checkrec deser $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1]} \
177			{22 44 66 333 3333 111}
178
179			# do ?tagvar? valvar body
180			$cmd do t v {
181			set t1 [string range $t 0 1]
182			if {11 == $t1 \|\| 55 == $t1} {
183			$cmd add $t1 $v$v
184			}
185			}
186			checkrec do $cmd {11\[0] 33\[0] 55\[0] 33\[1] 33\[2] 11\[1]
187			11\[2] 55\[1] 11\[3]} \
188			{22 44 66 333 3333 111 2222 6666 111111}
189
190			# get ?field ...?
191			set third [$cmd get 33]
192			if ![string equal {44 333 3333} "$third"] {
193			puts "ERR get1: rec\[33] = $third"
194			exit 1
195			}
196			set got [$cmd get {888 8181}]
197			if ![string equal 8181 $got] {
198			puts "ERR getdflt: rec\[888] = $got"
199			exit 1
200			}
201			set got [$cmd get]
202			checklst get2 {22 44 66 333 3333 111 2222 6666 111111} $got
203			set got [$cmd get -tag]
204			checklst get3 {
205			11 22
206			33 44
207			55 66
208			33 333
209			33 3333
210			11 111
211			11 2222
212			55 6666
213			11 111111
214			} $got
215
216			# set field ?value field value ...?
217			$cmd set 55 5555 77 88 33\[1] 3131
218			checkrec set $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1]
219			11\[2] 11\[3] 77} \
220			{22 44 5555 3131 3333 111 2222 111111 88}
221
222			# wrap ?options? recname
223			set emb [openIsisRec emb set 111 aaa 112 bbb 111 ccc]
224			if ![string equal $emb emb] {
225			puts "ERR emb: recname = $emb"
226			exit 1
227			}
228			checkrec ctor2 $emb {111\[0] 112 111\[1]} {aaa bbb ccc}
229			$cmd wrap -tag 999 $emb
230			checkrec wrap1 $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1]
231			11\[2] 11\[3] 77 999 111\[0] 112 111\[1]} \
232			{22 44 5555 3131 3333 111 2222 111111 88 3 aaa bbb ccc}
233			$cmd wrap -tag 888 -num 42 $emb
234			checkrec wrap2 $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1]
235			11\[2] 11\[3] 77 999 111\[0] 112\[0] 111\[1] 888
236			111\[2] 112\[1] 111\[3]} {22 44 5555 3131 3333 111 2222 111111 88
237			3 aaa bbb ccc 42 aaa bbb ccc}
238			$emb set 112 ddd
239			$cmd wrap -done -tag 999 $emb
240			checkrec wrap3 $cmd {11\[0] 33\[0] 55 33\[1] 33\[2] 11\[1] 11\[2]
241			11\[3] 77 999\[0] 111\[0] 112\[0] 111\[1] 888 111\[2] 112\[1]
242			111\[3] 999\[1] 111\[4] 112\[2] 111\[5]} {
243			22 44 5555 3131 3333 111 2222 111111 88
244			3 aaa bbb ccc 42 aaa bbb ccc 3 aaa ddd ccc}
245			if [catch {$emb get}] {} {
246			puts "ERR done1"
247			exit 1
248			}
249
250			# .path ?option arg ...?
251			set emb [$cmd .999]
252			checkrec path1 $emb {111\[0] 112 111\[1]} {aaa bbb ccc}
253			$emb done
254			set emb [$cmd .999\[1\]]
255			checkrec path2 $emb {111\[0] 112 111\[1]} {aaa ddd ccc}
256			$emb done
257			set emb [$cmd .999\[1\] get 112]
258			if ![string equal ddd $emb] {
259			puts "ERR path2: got = $emb"
260			exit 1
261			}
262			$cmd .999\[1\] do t v { set x $v }
263			$cmd .999\[1\] add 42 43 44 45
264			set emb [$cmd .999\[1\] clone emb]
265			if ![string equal $emb emb] {
266			puts "ERR path3: recname = $emb"
267			exit 1
268			}
269			checkrec path3 $emb {111\[0] 112 111\[1]} {aaa ddd ccc}
270			$emb done
271
272			if {! [expr $m % 1000]} {
273			puts "$n $m ..."
274			}
275			$cmd dele
276
277			# large argc
278			set tag [list]
279			set val [list]
280			for {set j 0} {529 >= $j} {incr j} {
281			$cmd add 433 blabla$j
282			lappend tag 433\[$j]
283			lappend val blabla$j
284			}
285			set cmd2 [openIsisRec]
286			eval $cmd2 add [$cmd get -tags]
287			checkrec argc $cmd2 $tag $val
288			$cmd dele
289			$cmd2 done
290			unset tag val
291			}
292
293			# done
294			$cmd done
295			if [catch {$cmd get}] {} {
296			puts "ERR done2"
297			exit 1
298			}
299
300			if {1000 > $mm && ! [expr $n % 1000]} {
301			puts "$n ..."
302			}
303			}
304
305			puts "ok."
306