diff options
author | rjohnson <rjohnson@noemail.net> | 1998-03-26 14:56:54 (GMT) |
---|---|---|
committer | rjohnson <rjohnson@noemail.net> | 1998-03-26 14:56:54 (GMT) |
commit | f3d590299d8632bc7d324901d27250ed07a6f074 (patch) | |
tree | c168cc164a71f320db9dcdfe7518ba7bd0d2c8d9 /tests/opt.test | |
parent | 26a76b6c669bbb7629454ffa56a7f3f501a86dae (diff) | |
download | tcl-f3d590299d8632bc7d324901d27250ed07a6f074.zip tcl-f3d590299d8632bc7d324901d27250ed07a6f074.tar.gz tcl-f3d590299d8632bc7d324901d27250ed07a6f074.tar.bz2 |
Initial revision
FossilOrigin-Name: f86c34e38d2a946e0ed196001fd756c57f90791a
Diffstat (limited to 'tests/opt.test')
-rw-r--r-- | tests/opt.test | 255 |
1 files changed, 255 insertions, 0 deletions
diff --git a/tests/opt.test b/tests/opt.test new file mode 100644 index 0000000..0b35b76 --- /dev/null +++ b/tests/opt.test @@ -0,0 +1,255 @@ +# Package covered: opt0.1/optparse.tcl +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1991-1993 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# SCCS: @(#) opt.test 1.2 97/08/20 15:57:18 + +if {[string compare test [info procs test]] == 1} then {source defs} + +# the package we are going to test +package require opt 0.1 + +# we are using implementation specifics to test the package + + +#### functions tests ##### + +set n $::tcl::OptDescN + +test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} { + list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr $n+1]] [::tcl::OptKeyRegister {}] +} "$n [expr $n+1] [expr $n+2]" + +test opt-2.1 {OptKeyDelete} { + list [::tcl::OptKeyRegister {} testkey] [::tcl::OptKeyDelete testkey] \ + [catch {::tcl::OptKeyDelete testkey} msg] $msg; +} {testkey {} 1 {can't unset "OptDesc(testkey)": no such element in array}} + + +test opt-3.1 {OptParse / temp key is removed} { + set n $::tcl::OptDescN + set prev [array names ::tcl::OptDesc] + ::tcl::OptKeyRegister {} $n + list [info exists ::tcl::OptDesc($n)]\ + [::tcl::OptKeyDelete $n]\ + [::tcl::OptParse {{-foo}} {}]\ + [info exists ::tcl::OptDesc($n)]\ + [expr {"[lsort $prev]"=="[lsort [array names ::tcl::OptDesc]]"}] +} {1 {} {} 0 1} + + +test opt-3.2 {OptParse / temp key is removed even on errors} { + set n $::tcl::OptDescN + catch {::tcl::OptKeyDelete $n} + list [catch {::tcl::OptParse {{-foo}} {-blah}}] \ + [info exists ::tcl::OptDesc($n)] +} {1 0} + +test opt-4.1 {OptProc} { + ::tcl::OptProc optTest {} {} + optTest ; + ::tcl::OptKeyDelete optTest +} {} + + +test opt-5.1 {OptProcArgGiven} { + ::tcl::OptProc optTest {{-foo}} { + if {[::tcl::OptProcArgGiven "-foo"]} { + return 1 + } else { + return 0 + } + } + list [optTest] [optTest -f] [optTest -F] [optTest -fOO] +} {0 1 1 1} + +test opt-6.1 {OptKeyParse} { + ::tcl::OptKeyRegister {} test; + list [catch {::tcl::OptKeyParse test {-help}} msg] $msg +} {1 {Usage information: + Var/FlagName Type Value Help + ------------ ---- ----- ---- + ( -help gives this help )}} + + +test opt-7.1 {OptCheckType} { + list \ + [::tcl::OptCheckType 23 int] \ + [::tcl::OptCheckType 23 float] \ + [::tcl::OptCheckType true boolean] \ + [::tcl::OptCheckType "-blah" any] \ + [::tcl::OptCheckType {a b c} list] \ + [::tcl::OptCheckType maYbe choice {yes maYbe no}] \ + [catch {::tcl::OptCheckType "-blah" string}] \ + [catch {::tcl::OptCheckType 6 boolean}] \ + [catch {::tcl::OptCheckType x float}] \ + [catch {::tcl::OptCheckType "a \{ c" list}] \ + [catch {::tcl::OptCheckType 2.3 int}] \ + [catch {::tcl::OptCheckType foo choice {x y Foo z}}] +} {23 23.0 1 -blah {a b c} maYbe 1 1 1 1 1 1} + + +test opt-8.1 {List utilities} { + ::tcl::Lempty {} +} 1 +test opt-8.2 {List utilities} { + ::tcl::Lempty {a b c} +} 0 +test opt-8.3 {List utilities} { + ::tcl::Lget {a {b c d} e} {1 2} +} d + +test opt-8.4 {List utilities} { + set l {a {b c d e} f} + ::tcl::Lvarset l {1 2} D + set l +} {a {b c D e} f} + +test opt-8.5 {List utilities} { + set l {a b c} + ::tcl::Lvarset1 l 6 X + set l +} {a b c {} {} {} X} + +test opt-8.6 {List utilities} { + set l {a {b c 7 e} f} + ::tcl::Lvarincr l {1 2} + set l +} {a {b c 8 e} f} + +test opt-8.7 {List utilities} { + set l {a {b c 7 e} f} + ::tcl::Lvarincr l {1 2} -9 + set l +} {a {b c -2 e} f} + +test opt-8.8 {List utilities} { + set l {{b c 7 e} f} + ::tcl::Lfirst $l +} {b c 7 e} + + +test opt-8.9 {List utilities} { + set l {a {b c 7 e} f} + ::tcl::Lrest $l +} {{b c 7 e} f} + +test opt-8.10 {List utilities} { + set l {a {b c 7 e} f} + ::tcl::Lvarpop l + set l +} {{b c 7 e} f} + +test opt-8.11 {List utilities} { + catch {unset x} + set l {a {b c 7 e} f} + list [::tcl::Lassign $l u v w x] \ + $u $v $w [info exists x] +} {3 a {b c 7 e} f 0} + +test opt-9.1 {Misc utilities} { + catch {unset v} + ::tcl::SetMax v 3 + ::tcl::SetMax v 7 + ::tcl::SetMax v 6 + set v +} 7 + +test opt-9.2 {Misc utilities} { + catch {unset v} + ::tcl::SetMin v 3 + ::tcl::SetMin v -7 + ::tcl::SetMin v 1 + set v +} -7 + +#### behaviour tests ##### + +test opt-10.1 {ambigous flags} { + ::tcl::OptProc optTest {{-fla} {-other} {-flag2xyz} {-flag3xyz}} {} + catch {optTest -fL} msg + set msg +} {ambigous option "-fL", choose from: + -fla boolflag (false) + -flag2xyz boolflag (false) + -flag3xyz boolflag (false) } + +test opt-10.2 {non ambigous flags} { + ::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} { + return $flag2xyz + } + optTest -fLaG2 +} 1 + +test opt-10.3 {non ambigous flags because of exact match} { + ::tcl::OptProc optTest {{-flag1x} {-other} {-flag1} {-flag1xy}} { + return $flag1 + } + optTest -flAg1 +} 1 + +test opt-10.4 {ambigous flags, not exact match} { + ::tcl::OptProc optTest {{-flag1xy} {-other} {-flag1} {-flag1xyz}} { + return $flag1 + } + catch {optTest -fLag1X} msg + set msg +} {ambigous option "-fLag1X", choose from: + -flag1xy boolflag (false) + -flag1xyz boolflag (false) } + + + +# medium size overall test example: (defined once) +::tcl::OptProc optTest { + {cmd -choice {print save delete} "sub command to choose"} + {-allowBoing -boolean true} + {arg2 -string "this is help"} + {?arg3? 7 "optional number"} + {-moreflags} +} { + list $cmd $allowBoing $arg2 $arg3 $moreflags +} + +test opt-10.5 {medium size overall test} { + list [catch {optTest} msg] $msg +} {1 {no value given for parameter "cmd" (use -help for full usage) : + cmd choice (print save delete) sub command to choose}} + + +test opt-10.6 {medium size overall test} { + list [catch {optTest -help} msg] $msg +} {1 {Usage information: + Var/FlagName Type Value Help + ------------ ---- ----- ---- + ( -help gives this help ) + cmd choice (print save delete) sub command to choose + -allowBoing boolean (true) + arg2 string () this is help + ?arg3? int (7) optional number + -moreflags boolflag (false) }} + +test opt-10.7 {medium size overall test} { + optTest save tst +} {save 1 tst 7 0} + +test opt-10.8 {medium size overall test} { + optTest save -allowBoing false -- 8 +} {save 0 8 7 0} + +test opt-10.9 {medium size overall test} { + optTest save tst -m -- +} {save 1 tst 7 1} + +test opt-10.10 {medium size overall test} { + list [catch {optTest save tst foo} msg] [lindex [split $msg "\n"] 0] +} {1 {too many arguments (unexpected argument(s): foo), usage:}} + |