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