tcl/tests/opt.test

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