1# Package covered:  opt1.0/optparse.tcl
2#
3# This file contains a collection of tests for one or more of the Tcl
4# built-in commands.  Sourcing this file into Tcl runs the tests and
5# generates output for errors.  No output means no errors were found.
6#
7# Copyright © 1991-1993 The Regents of the University of California.
8# Copyright © 1994-1997 Sun Microsystems, Inc.
9# Copyright © 1998-1999 Scriptics Corporation.
10#
11# See the file "license.terms" for information on usage and redistribution
12# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13
14if {"::tcltest" ni [namespace children]} {
15    package require tcltest 2.5
16    namespace import -force ::tcltest::*
17}
18
19# the package we are going to test
20package require opt 0.4.8
21
22# we are using implementation specifics to test the package
23
24
25#### functions tests #####
26
27set n $::tcl::OptDescN
28
29test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} {
30    list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr {$n+1}]] [::tcl::OptKeyRegister {}]
31} "$n [expr {$n+1}] [expr {$n+2}]"
32
33test opt-2.1 {OptKeyDelete} {
34    list [::tcl::OptKeyRegister {} testkey] \
35	    [info exists ::tcl::OptDesc(testkey)] \
36	    [::tcl::OptKeyDelete testkey] \
37	    [info exists ::tcl::OptDesc(testkey)]
38} {testkey 1 {} 0}
39
40test opt-3.1 {OptParse / temp key is removed} {
41    set n $::tcl::OptDescN
42    set prev [array names ::tcl::OptDesc]
43    ::tcl::OptKeyRegister {} $n
44    list [info exists ::tcl::OptDesc($n)]\
45	    [::tcl::OptKeyDelete $n]\
46	    [::tcl::OptParse {{-foo}} {}]\
47	    [info exists ::tcl::OptDesc($n)]\
48	    [expr {"[lsort $prev]"=="[lsort [array names ::tcl::OptDesc]]"}]
49} {1 {} {} 0 1}
50test opt-3.2 {OptParse / temp key is removed even on errors} {
51    set n $::tcl::OptDescN
52    catch {::tcl::OptKeyDelete $n}
53    list [catch {::tcl::OptParse {{-foo}} {-blah}}] \
54	    [info exists ::tcl::OptDesc($n)]
55} {1 0}
56
57test opt-4.1 {OptProc} {
58    ::tcl::OptProc optTest {} {}
59    optTest
60    ::tcl::OptKeyDelete optTest
61} {}
62
63test opt-5.1 {OptProcArgGiven} {
64    ::tcl::OptProc optTest {{-foo}} {
65	if {[::tcl::OptProcArgGiven "-foo"]} {
66	    return 1
67	} else {
68	    return 0
69	}
70    }
71    list [optTest] [optTest -f] [optTest -F] [optTest -fOO]
72} {0 1 1 1}
73
74test opt-6.1 {OptKeyParse} {
75    ::tcl::OptKeyRegister {} test
76    list [catch {::tcl::OptKeyParse test {-help}} msg] $msg
77} {1 {Usage information:
78    Var/FlagName Type Value Help
79    ------------ ---- ----- ----
80    (-help                  gives this help)}}
81
82test opt-7.1 {OptCheckType} {
83    list \
84	    [::tcl::OptCheckType 23 int] \
85	    [::tcl::OptCheckType 23 float] \
86	    [::tcl::OptCheckType true boolean] \
87	    [::tcl::OptCheckType "-blah" any] \
88	    [::tcl::OptCheckType {a b c} list] \
89	    [::tcl::OptCheckType maYbe choice {yes maYbe no}] \
90	    [catch {::tcl::OptCheckType "-blah" string}] \
91	    [catch {::tcl::OptCheckType 6 boolean}] \
92	    [catch {::tcl::OptCheckType x float}] \
93	    [catch {::tcl::OptCheckType "a \{ c" list}] \
94	    [catch {::tcl::OptCheckType 2.3 int}] \
95	    [catch {::tcl::OptCheckType foo choice {x y Foo z}}]
96} {23 23.0 1 -blah {a b c} maYbe 1 1 1 1 1 1}
97
98test opt-8.1 {List utilities} {
99    ::tcl::Lempty {}
100} 1
101test opt-8.2 {List utilities} {
102    ::tcl::Lempty {a b c}
103} 0
104test opt-8.3 {List utilities} {
105    ::tcl::Lget {a {b c d} e} {1 2}
106} d
107test opt-8.4 {List utilities} {
108    set l {a {b c d e} f}
109    ::tcl::Lvarset l {1 2} D
110    set l
111} {a {b c D e} f}
112test opt-8.5 {List utilities} {
113    set l {a b c}
114    ::tcl::Lvarset1 l 6 X
115    set l
116} {a b c {} {} {} X}
117test opt-8.6 {List utilities} {
118    set l {a {b c 7 e} f}
119    ::tcl::Lvarincr l {1 2}
120    set l
121} {a {b c 8 e} f}
122test opt-8.7 {List utilities} {
123    set l {a {b c 7 e} f}
124    ::tcl::Lvarincr l {1 2} -9
125    set l
126} {a {b c -2 e} f}
127# 8.8 and 8.9 missing?
128test opt-8.10 {List utilities} {
129    set l {a {b c 7 e} f}
130    ::tcl::Lvarpop l
131    set l
132} {{b c 7 e} f}
133test opt-8.11 {List utilities} {
134    catch {unset x}
135    set l {a {b c 7 e} f}
136    list [::tcl::Lassign $l u v w x] \
137	    $u $v $w [info exists x]
138} {3 a {b c 7 e} f 0}
139
140test opt-9.1 {Misc utilities} {
141    catch {unset v}
142    ::tcl::SetMax v 3
143    ::tcl::SetMax v 7
144    ::tcl::SetMax v 6
145    set v
146} 7
147test opt-9.2 {Misc utilities} {
148    catch {unset v}
149    ::tcl::SetMin v 3
150    ::tcl::SetMin v -7
151    ::tcl::SetMin v 1
152    set v
153} -7
154
155#### behaviour tests #####
156
157test opt-10.1 {ambigous flags} {
158    ::tcl::OptProc optTest {{-fla} {-other} {-flag2xyz} {-flag3xyz}} {}
159    catch {optTest -fL} msg
160    set msg
161} {ambigous option "-fL", choose from:
162    -fla      boolflag (false)
163    -flag2xyz boolflag (false)
164    -flag3xyz boolflag (false)}
165test opt-10.2 {non ambigous flags} {
166    ::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} {
167	return $flag2xyz
168    }
169    optTest -fLaG2
170} 1
171test opt-10.3 {non ambigous flags because of exact match} {
172    ::tcl::OptProc optTest {{-flag1x} {-other} {-flag1} {-flag1xy}} {
173	return $flag1
174    }
175    optTest -flAg1
176} 1
177test opt-10.4 {ambigous flags, not exact match} {
178    ::tcl::OptProc optTest {{-flag1xy} {-other} {-flag1} {-flag1xyz}} {
179	return $flag1
180    }
181    catch {optTest -fLag1X} msg
182    set msg
183} {ambigous option "-fLag1X", choose from:
184    -flag1xy  boolflag (false)
185    -flag1xyz boolflag (false)}
186
187# medium size overall test example: (defined once)
188::tcl::OptProc optTest {
189    {cmd -choice {print save delete} "sub command to choose"}
190    {-allowBoing -boolean true}
191    {arg2 -string "this is help"}
192    {?arg3? 7 "optional number"}
193    {-moreflags}
194} {
195    list $cmd $allowBoing $arg2 $arg3 $moreflags
196}
197
198test opt-10.5 {medium size overall test} {
199    list [catch {optTest} msg] $msg
200} {1 {no value given for parameter "cmd" (use -help for full usage) :
201    cmd choice (print save delete) sub command to choose}}
202test opt-10.6 {medium size overall test} {
203    list [catch {optTest -help} msg] $msg
204} {1 {Usage information:
205    Var/FlagName Type     Value   Help
206    ------------ ----     -----   ----
207    (-help                        gives this help)
208    cmd          choice   (print save delete) sub command to choose
209    -allowBoing  boolean  (true)
210    arg2         string   ()      this is help
211    ?arg3?       int      (7)     optional number
212    -moreflags   boolflag (false)}}
213test opt-10.7 {medium size overall test} {
214    optTest save tst
215} {save 1 tst 7 0}
216test opt-10.8 {medium size overall test} {
217    optTest save -allowBoing false -- 8
218} {save 0 8 7 0}
219test opt-10.9 {medium size overall test} {
220    optTest save tst -m --
221} {save 1 tst 7 1}
222test opt-10.10 {medium size overall test} {
223    list [catch {optTest save tst foo} msg] [lindex [split $msg "\n"] 0]
224} {1 {too many arguments (unexpected argument(s): foo), usage:}}
225
226test opt-11.1 {too many args test 2} {
227    set key [::tcl::OptKeyRegister {-foo}]
228    list [catch {::tcl::OptKeyParse $key {-foo blah}} msg] $msg\
229	    [::tcl::OptKeyDelete $key]
230} {1 {too many arguments (unexpected argument(s): blah), usage:
231    Var/FlagName Type     Value   Help
232    ------------ ----     -----   ----
233    (-help                        gives this help)
234    -foo         boolflag (false)} {}}
235test opt-11.2 {default value for args} {
236    set args {}
237    set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}]
238    ::tcl::OptKeyParse $key {}
239    ::tcl::OptKeyDelete $key
240    set args
241} {a b c}
242
243# cleanup
244::tcltest::cleanupTests
245return
246