Initial revision

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