os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/opt.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/opt.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,282 @@
1.4 +# Package covered: opt1.0/optparse.tcl
1.5 +#
1.6 +# This file contains a collection of tests for one or more of the Tcl
1.7 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.8 +# generates output for errors. No output means no errors were found.
1.9 +#
1.10 +# Copyright (c) 1991-1993 The Regents of the University of California.
1.11 +# Copyright (c) 1994-1997 Sun Microsystems, Inc.
1.12 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.13 +#
1.14 +# See the file "license.terms" for information on usage and redistribution
1.15 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 +#
1.17 +# RCS: @(#) $Id: opt.test,v 1.8 2000/07/18 21:30:41 ericm Exp $
1.18 +
1.19 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.20 + package require tcltest
1.21 + namespace import -force ::tcltest::*
1.22 +}
1.23 +
1.24 +# the package we are going to test
1.25 +package require opt 0.4.1
1.26 +
1.27 +# we are using implementation specifics to test the package
1.28 +
1.29 +
1.30 +#### functions tests #####
1.31 +
1.32 +set n $::tcl::OptDescN
1.33 +
1.34 +test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} {
1.35 + list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr $n+1]] [::tcl::OptKeyRegister {}]
1.36 +} "$n [expr $n+1] [expr $n+2]"
1.37 +
1.38 +test opt-2.1 {OptKeyDelete} {
1.39 + list [::tcl::OptKeyRegister {} testkey] \
1.40 + [info exists ::tcl::OptDesc(testkey)] \
1.41 + [::tcl::OptKeyDelete testkey] \
1.42 + [info exists ::tcl::OptDesc(testkey)]
1.43 +} {testkey 1 {} 0}
1.44 +
1.45 +
1.46 +test opt-3.1 {OptParse / temp key is removed} {
1.47 + set n $::tcl::OptDescN
1.48 + set prev [array names ::tcl::OptDesc]
1.49 + ::tcl::OptKeyRegister {} $n
1.50 + list [info exists ::tcl::OptDesc($n)]\
1.51 + [::tcl::OptKeyDelete $n]\
1.52 + [::tcl::OptParse {{-foo}} {}]\
1.53 + [info exists ::tcl::OptDesc($n)]\
1.54 + [expr {"[lsort $prev]"=="[lsort [array names ::tcl::OptDesc]]"}]
1.55 +} {1 {} {} 0 1}
1.56 +
1.57 +
1.58 +test opt-3.2 {OptParse / temp key is removed even on errors} {
1.59 + set n $::tcl::OptDescN
1.60 + catch {::tcl::OptKeyDelete $n}
1.61 + list [catch {::tcl::OptParse {{-foo}} {-blah}}] \
1.62 + [info exists ::tcl::OptDesc($n)]
1.63 +} {1 0}
1.64 +
1.65 +test opt-4.1 {OptProc} {
1.66 + ::tcl::OptProc optTest {} {}
1.67 + optTest ;
1.68 + ::tcl::OptKeyDelete optTest
1.69 +} {}
1.70 +
1.71 +
1.72 +test opt-5.1 {OptProcArgGiven} {
1.73 + ::tcl::OptProc optTest {{-foo}} {
1.74 + if {[::tcl::OptProcArgGiven "-foo"]} {
1.75 + return 1
1.76 + } else {
1.77 + return 0
1.78 + }
1.79 + }
1.80 + list [optTest] [optTest -f] [optTest -F] [optTest -fOO]
1.81 +} {0 1 1 1}
1.82 +
1.83 +test opt-6.1 {OptKeyParse} {
1.84 + ::tcl::OptKeyRegister {} test;
1.85 + list [catch {::tcl::OptKeyParse test {-help}} msg] $msg
1.86 +} {1 {Usage information:
1.87 + Var/FlagName Type Value Help
1.88 + ------------ ---- ----- ----
1.89 + ( -help gives this help )}}
1.90 +
1.91 +
1.92 +test opt-7.1 {OptCheckType} {
1.93 + list \
1.94 + [::tcl::OptCheckType 23 int] \
1.95 + [::tcl::OptCheckType 23 float] \
1.96 + [::tcl::OptCheckType true boolean] \
1.97 + [::tcl::OptCheckType "-blah" any] \
1.98 + [::tcl::OptCheckType {a b c} list] \
1.99 + [::tcl::OptCheckType maYbe choice {yes maYbe no}] \
1.100 + [catch {::tcl::OptCheckType "-blah" string}] \
1.101 + [catch {::tcl::OptCheckType 6 boolean}] \
1.102 + [catch {::tcl::OptCheckType x float}] \
1.103 + [catch {::tcl::OptCheckType "a \{ c" list}] \
1.104 + [catch {::tcl::OptCheckType 2.3 int}] \
1.105 + [catch {::tcl::OptCheckType foo choice {x y Foo z}}]
1.106 +} {23 23.0 1 -blah {a b c} maYbe 1 1 1 1 1 1}
1.107 +
1.108 +
1.109 +test opt-8.1 {List utilities} {
1.110 + ::tcl::Lempty {}
1.111 +} 1
1.112 +test opt-8.2 {List utilities} {
1.113 + ::tcl::Lempty {a b c}
1.114 +} 0
1.115 +test opt-8.3 {List utilities} {
1.116 + ::tcl::Lget {a {b c d} e} {1 2}
1.117 +} d
1.118 +
1.119 +test opt-8.4 {List utilities} {
1.120 + set l {a {b c d e} f}
1.121 + ::tcl::Lvarset l {1 2} D
1.122 + set l
1.123 +} {a {b c D e} f}
1.124 +
1.125 +test opt-8.5 {List utilities} {
1.126 + set l {a b c}
1.127 + ::tcl::Lvarset1 l 6 X
1.128 + set l
1.129 +} {a b c {} {} {} X}
1.130 +
1.131 +test opt-8.6 {List utilities} {
1.132 + set l {a {b c 7 e} f}
1.133 + ::tcl::Lvarincr l {1 2}
1.134 + set l
1.135 +} {a {b c 8 e} f}
1.136 +
1.137 +test opt-8.7 {List utilities} {
1.138 + set l {a {b c 7 e} f}
1.139 + ::tcl::Lvarincr l {1 2} -9
1.140 + set l
1.141 +} {a {b c -2 e} f}
1.142 +
1.143 +test opt-8.10 {List utilities} {
1.144 + set l {a {b c 7 e} f}
1.145 + ::tcl::Lvarpop l
1.146 + set l
1.147 +} {{b c 7 e} f}
1.148 +
1.149 +test opt-8.11 {List utilities} {
1.150 + catch {unset x}
1.151 + set l {a {b c 7 e} f}
1.152 + list [::tcl::Lassign $l u v w x] \
1.153 + $u $v $w [info exists x]
1.154 +} {3 a {b c 7 e} f 0}
1.155 +
1.156 +test opt-9.1 {Misc utilities} {
1.157 + catch {unset v}
1.158 + ::tcl::SetMax v 3
1.159 + ::tcl::SetMax v 7
1.160 + ::tcl::SetMax v 6
1.161 + set v
1.162 +} 7
1.163 +
1.164 +test opt-9.2 {Misc utilities} {
1.165 + catch {unset v}
1.166 + ::tcl::SetMin v 3
1.167 + ::tcl::SetMin v -7
1.168 + ::tcl::SetMin v 1
1.169 + set v
1.170 +} -7
1.171 +
1.172 +#### behaviour tests #####
1.173 +
1.174 +test opt-10.1 {ambigous flags} {
1.175 + ::tcl::OptProc optTest {{-fla} {-other} {-flag2xyz} {-flag3xyz}} {}
1.176 + catch {optTest -fL} msg
1.177 + set msg
1.178 +} {ambigous option "-fL", choose from:
1.179 + -fla boolflag (false)
1.180 + -flag2xyz boolflag (false)
1.181 + -flag3xyz boolflag (false) }
1.182 +
1.183 +test opt-10.2 {non ambigous flags} {
1.184 + ::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} {
1.185 + return $flag2xyz
1.186 + }
1.187 + optTest -fLaG2
1.188 +} 1
1.189 +
1.190 +test opt-10.3 {non ambigous flags because of exact match} {
1.191 + ::tcl::OptProc optTest {{-flag1x} {-other} {-flag1} {-flag1xy}} {
1.192 + return $flag1
1.193 + }
1.194 + optTest -flAg1
1.195 +} 1
1.196 +
1.197 +test opt-10.4 {ambigous flags, not exact match} {
1.198 + ::tcl::OptProc optTest {{-flag1xy} {-other} {-flag1} {-flag1xyz}} {
1.199 + return $flag1
1.200 + }
1.201 + catch {optTest -fLag1X} msg
1.202 + set msg
1.203 +} {ambigous option "-fLag1X", choose from:
1.204 + -flag1xy boolflag (false)
1.205 + -flag1xyz boolflag (false) }
1.206 +
1.207 +
1.208 +
1.209 +# medium size overall test example: (defined once)
1.210 +::tcl::OptProc optTest {
1.211 + {cmd -choice {print save delete} "sub command to choose"}
1.212 + {-allowBoing -boolean true}
1.213 + {arg2 -string "this is help"}
1.214 + {?arg3? 7 "optional number"}
1.215 + {-moreflags}
1.216 +} {
1.217 + list $cmd $allowBoing $arg2 $arg3 $moreflags
1.218 +}
1.219 +
1.220 +test opt-10.5 {medium size overall test} {
1.221 + list [catch {optTest} msg] $msg
1.222 +} {1 {no value given for parameter "cmd" (use -help for full usage) :
1.223 + cmd choice (print save delete) sub command to choose}}
1.224 +
1.225 +
1.226 +test opt-10.6 {medium size overall test} {
1.227 + list [catch {optTest -help} msg] $msg
1.228 +} {1 {Usage information:
1.229 + Var/FlagName Type Value Help
1.230 + ------------ ---- ----- ----
1.231 + ( -help gives this help )
1.232 + cmd choice (print save delete) sub command to choose
1.233 + -allowBoing boolean (true)
1.234 + arg2 string () this is help
1.235 + ?arg3? int (7) optional number
1.236 + -moreflags boolflag (false) }}
1.237 +
1.238 +test opt-10.7 {medium size overall test} {
1.239 + optTest save tst
1.240 +} {save 1 tst 7 0}
1.241 +
1.242 +test opt-10.8 {medium size overall test} {
1.243 + optTest save -allowBoing false -- 8
1.244 +} {save 0 8 7 0}
1.245 +
1.246 +test opt-10.9 {medium size overall test} {
1.247 + optTest save tst -m --
1.248 +} {save 1 tst 7 1}
1.249 +
1.250 +test opt-10.10 {medium size overall test} {
1.251 + list [catch {optTest save tst foo} msg] [lindex [split $msg "\n"] 0]
1.252 +} {1 {too many arguments (unexpected argument(s): foo), usage:}}
1.253 +
1.254 +test opt-11.1 {too many args test 2} {
1.255 + set key [::tcl::OptKeyRegister {-foo}]
1.256 + list [catch {::tcl::OptKeyParse $key {-foo blah}} msg] $msg\
1.257 + [::tcl::OptKeyDelete $key]
1.258 +} {1 {too many arguments (unexpected argument(s): blah), usage:
1.259 + Var/FlagName Type Value Help
1.260 + ------------ ---- ----- ----
1.261 + ( -help gives this help )
1.262 + -foo boolflag (false) } {}}
1.263 +test opt-11.2 {default value for args} {
1.264 + set args {}
1.265 + set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}]
1.266 + ::tcl::OptKeyParse $key {}
1.267 + ::tcl::OptKeyDelete $key
1.268 + set args
1.269 +} {a b c}
1.270 +
1.271 +# cleanup
1.272 +::tcltest::cleanupTests
1.273 +return
1.274 +
1.275 +
1.276 +
1.277 +
1.278 +
1.279 +
1.280 +
1.281 +
1.282 +
1.283 +
1.284 +
1.285 +