git.rot13.org Git - webpac/blob - openisis/tcl/test/testcli.tcl

   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: 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