summaryrefslogtreecommitdiffstats
path: root/tests/opt.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/opt.test')
-rw-r--r--tests/opt.test90
1 files changed, 29 insertions, 61 deletions
diff --git a/tests/opt.test b/tests/opt.test
index ce79827..2732d40 100644
--- a/tests/opt.test
+++ b/tests/opt.test
@@ -1,4 +1,4 @@
-# Package covered: opt0.1/optparse.tcl
+# Package covered: opt1.0/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
@@ -6,16 +6,18 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: opt.test,v 1.3 1998/09/14 18:40:12 stanton Exp $
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
# the package we are going to test
-package require opt 0.1
+package require opt 0.4.6
# we are using implementation specifics to test the package
@@ -29,10 +31,11 @@ test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing k
} "$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}}
-
+ list [::tcl::OptKeyRegister {} testkey] \
+ [info exists ::tcl::OptDesc(testkey)] \
+ [::tcl::OptKeyDelete testkey] \
+ [info exists ::tcl::OptDesc(testkey)]
+} {testkey 1 {} 0}
test opt-3.1 {OptParse / temp key is removed} {
set n $::tcl::OptDescN
@@ -44,8 +47,6 @@ test opt-3.1 {OptParse / temp key is removed} {
[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}
@@ -55,11 +56,10 @@ test opt-3.2 {OptParse / temp key is removed even on errors} {
test opt-4.1 {OptProc} {
::tcl::OptProc optTest {} {}
- optTest ;
+ optTest
::tcl::OptKeyDelete optTest
} {}
-
test opt-5.1 {OptProcArgGiven} {
::tcl::OptProc optTest {{-foo}} {
if {[::tcl::OptProcArgGiven "-foo"]} {
@@ -72,13 +72,12 @@ test opt-5.1 {OptProcArgGiven} {
} {0 1 1 1}
test opt-6.1 {OptKeyParse} {
- ::tcl::OptKeyRegister {} test;
+ ::tcl::OptKeyRegister {} test
list [catch {::tcl::OptKeyParse test {-help}} msg] $msg
} {1 {Usage information:
Var/FlagName Type Value Help
------------ ---- ----- ----
- ( -help gives this help )}}
-
+ (-help gives this help)}}
test opt-7.1 {OptCheckType} {
list \
@@ -96,7 +95,6 @@ test opt-7.1 {OptCheckType} {
[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
@@ -106,48 +104,32 @@ test opt-8.2 {List utilities} {
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}
-
+# 8.8 and 8.9 missing?
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}
@@ -162,7 +144,6 @@ test opt-9.1 {Misc utilities} {
::tcl::SetMax v 6
set v
} 7
-
test opt-9.2 {Misc utilities} {
catch {unset v}
::tcl::SetMin v 3
@@ -178,24 +159,21 @@ test opt-10.1 {ambigous flags} {
catch {optTest -fL} msg
set msg
} {ambigous option "-fL", choose from:
- -fla boolflag (false)
- -flag2xyz boolflag (false)
- -flag3xyz boolflag (false) }
-
+ -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
@@ -203,10 +181,8 @@ test opt-10.4 {ambigous flags, not exact match} {
catch {optTest -fLag1X} msg
set msg
} {ambigous option "-fLag1X", choose from:
- -flag1xy boolflag (false)
- -flag1xyz boolflag (false) }
-
-
+ -flag1xy boolflag (false)
+ -flag1xyz boolflag (false)}
# medium size overall test example: (defined once)
::tcl::OptProc optTest {
@@ -223,37 +199,30 @@ 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 )
+ (-help gives this help)
cmd choice (print save delete) sub command to choose
- -allowBoing boolean (true)
+ -allowBoing boolean (true)
arg2 string () this is help
?arg3? int (7) optional number
- -moreflags boolflag (false) }}
-
+ -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:}}
-
test opt-11.1 {too many args test 2} {
set key [::tcl::OptKeyRegister {-foo}]
list [catch {::tcl::OptKeyParse $key {-foo blah}} msg] $msg\
@@ -261,11 +230,8 @@ test opt-11.1 {too many args test 2} {
} {1 {too many arguments (unexpected argument(s): blah), usage:
Var/FlagName Type Value Help
------------ ---- ----- ----
- ( -help gives this help )
- -foo boolflag (false) } {}}
-
-
-
+ (-help gives this help)
+ -foo boolflag (false)} {}}
test opt-11.2 {default value for args} {
set args {}
set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}]
@@ -274,4 +240,6 @@ test opt-11.2 {default value for args} {
set args
} {a b c}
-
+# cleanup
+::tcltest::cleanupTests
+return
generated by cgit v0.12 at 2025-11-28 21:53:50 (GMT)