util/src/TclTk/tcl8.6.12/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 if {"::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
  20 package require opt 0.4.8
  21
  22 # we are using implementation specifics to test the package
  23
  24
  25 #### functions tests #####
  26
  27 set n $::tcl::OptDescN
  28
  29 test 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
  33 test 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
  40 test 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}
  50 test 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
  57 test opt-4.1 {OptProc} {
  58     ::tcl::OptProc optTest {} {}
  59     optTest
  60     ::tcl::OptKeyDelete optTest
  61 } {}
  62
  63 test 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
  74 test 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
  82 test 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
  98 test opt-8.1 {List utilities} {
  99     ::tcl::Lempty {}
 100 } 1
 101 test opt-8.2 {List utilities} {
 102     ::tcl::Lempty {a b c}
 103 } 0
 104 test opt-8.3 {List utilities} {
 105     ::tcl::Lget {a {b c d} e} {1 2}
 106 } d
 107 test 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}
 112 test 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}
 117 test 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}
 122 test 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?
 128 test 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}
 133 test 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
 140 test 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
 147 test 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
 157 test 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)}
 165 test opt-10.2 {non ambigous flags} {
 166     ::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} {
 167         return $flag2xyz
 168     }
 169     optTest -fLaG2
 170 } 1
 171 test 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
 177 test 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
 198 test 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}}
 202 test 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)}}
 213 test opt-10.7 {medium size overall test} {
 214     optTest save tst
 215 } {save 1 tst 7 0}
 216 test opt-10.8 {medium size overall test} {
 217     optTest save -allowBoing false -- 8
 218 } {save 0 8 7 0}
 219 test opt-10.9 {medium size overall test} {
 220     optTest save tst -m --
 221 } {save 1 tst 7 1}
 222 test 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
 226 test 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)} {}}
 235 test 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
 245 return