home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / tests / opt.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  6.3 KB  |  237 lines  |  [TEXT/ALFA]
  1. # Package covered:  opt0.1/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. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. # SCCS: @(#) opt.test 1.1 97/08/14 00:53:59
  14.  
  15. if {[string compare test [info procs test]] == 1} then {source defs}
  16.  
  17. # the package we are going to test
  18. package require opt 0.1
  19.  
  20. # we are using implementation specifics to test the package
  21.  
  22.  
  23. #### functions tests #####
  24.  
  25. set n $::tcl::OptDescN
  26.  
  27. test opt-1.1 {OptKeyRegister / check that auto allocation is skipping existing keys} {
  28.     list [::tcl::OptKeyRegister {} $n] [::tcl::OptKeyRegister {} [expr $n+1]] [::tcl::OptKeyRegister {}]
  29. } "$n [expr $n+1] [expr $n+2]"
  30.  
  31. test opt-2.1 {OptKeyDelete} {
  32.     list [::tcl::OptKeyRegister {} testkey] [::tcl::OptKeyDelete testkey] \
  33.         [catch {::tcl::OptKeyDelete testkey} msg] $msg;
  34. } {testkey {} 1 {can't unset "OptDesc(testkey)": no such element in array}}
  35.  
  36.  
  37. test opt-3.1 {OptParse / temp key is removed} {
  38.     set n $::tcl::OptDescN
  39.     set prev [array names ::tcl::OptDesc]
  40.     ::tcl::OptKeyRegister {} $n
  41.     list [info exists ::tcl::OptDesc($n)]\
  42.         [::tcl::OptKeyDelete $n]\
  43.         [::tcl::OptParse {{-foo}} {}]\
  44.         [info exists ::tcl::OptDesc($n)]\
  45.         [expr {"[lsort $prev]"=="[lsort [array names ::tcl::OptDesc]]"}]
  46. } {1 {} {} 0 1}
  47.  
  48.  
  49. test opt-3.2 {OptParse / temp key is removed even on errors} {
  50.     set n $::tcl::OptDescN
  51.     catch {::tcl::OptKeyDelete $n}
  52.     list [catch {::tcl::OptParse {{-foo}} {-blah}}] \
  53.         [info exists ::tcl::OptDesc($n)]
  54. } {1 0}
  55.  
  56. test opt-4.1 {OptProc} {
  57.     ::tcl::OptProc optTest {} {}
  58.     optTest ;
  59.     ::tcl::OptKeyDelete optTest
  60. } {}
  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.  
  83. test opt-7.1 {OptCheckType} {
  84.     list \
  85.         [::tcl::OptCheckType 23 int] \
  86.         [::tcl::OptCheckType 23 float] \
  87.         [::tcl::OptCheckType true boolean] \
  88.         [::tcl::OptCheckType "-blah" any] \
  89.         [::tcl::OptCheckType {a b c} list] \
  90.         [::tcl::OptCheckType maYbe choice {yes maYbe no}] \
  91.         [catch {::tcl::OptCheckType "-blah" string}] \
  92.         [catch {::tcl::OptCheckType 6 boolean}] \
  93.         [catch {::tcl::OptCheckType x float}] \
  94.         [catch {::tcl::OptCheckType "a \{ c" list}] \
  95.         [catch {::tcl::OptCheckType 2.3 int}] \
  96.         [catch {::tcl::OptCheckType foo choice {x y Foo z}}]
  97. } {23 23.0 1 -blah {a b c} maYbe 1 1 1 1 1 1}
  98.  
  99.  
  100. test opt-8.1 {List utilities} {
  101.     ::tcl::Lempty {}
  102. } 1
  103. test opt-8.2 {List utilities} {
  104.     ::tcl::Lempty {a b c}
  105. } 0
  106. test opt-8.3 {List utilities} {
  107.     ::tcl::Lget {a {b c d} e} {1 2}
  108. } d
  109.  
  110. test opt-8.4 {List utilities} {
  111.     set l {a {b c d e} f}
  112.     ::tcl::Lvarset l {1 2} D
  113.     set l
  114. } {a {b c D e} f}
  115.  
  116. test opt-8.5 {List utilities} {
  117.     set l {a b c}
  118.     ::tcl::Lvarset1 l 6 X
  119.     set l
  120. } {a b c {} {} {} X}
  121.  
  122. test opt-8.6 {List utilities} {
  123.     set l {a {b c 7 e} f}
  124.     ::tcl::Lvarincr l {1 2}
  125.     set l
  126. } {a {b c 8 e} f}
  127.  
  128. test opt-8.7 {List utilities} {
  129.     set l {a {b c 7 e} f}
  130.     ::tcl::Lvarincr l {1 2} -9
  131.     set l
  132. } {a {b c -2 e} f}
  133.  
  134. test opt-8.8 {List utilities} {
  135.     set l {{b c 7 e} f}
  136.     ::tcl::Lfirst $l
  137. } {b c 7 e}
  138.  
  139.  
  140. test opt-8.9 {List utilities} {
  141.     set l {a {b c 7 e} f}
  142.     ::tcl::Lrest $l
  143. } {{b c 7 e} f}
  144.  
  145. test opt-8.10 {List utilities} {
  146.     set l {a {b c 7 e} f}
  147.     ::tcl::Lvarpop l
  148.     set l
  149. } {{b c 7 e} f}
  150.  
  151. test opt-8.11 {List utilities} {
  152.     set l {a {b c 7 e} f}
  153.     list [::tcl::Lassign $l u v w x] \
  154.         $u $v $w [info exists x]
  155. } {3 a {b c 7 e} f 0}
  156.  
  157. test opt-9.1 {Misc utilities} {
  158.     catch {unset v}
  159.     ::tcl::SetMax v 3
  160.     ::tcl::SetMax v 7
  161.     ::tcl::SetMax v 6
  162.     set v
  163. } 7
  164.  
  165. test opt-9.2 {Misc utilities} {
  166.     catch {unset v}
  167.     ::tcl::SetMin v 3
  168.     ::tcl::SetMin v -7
  169.     ::tcl::SetMin v 1
  170.     set v
  171. } -7
  172.  
  173. #### behaviour tests #####
  174.  
  175. test opt-10.1 {ambigous flags} {
  176.     ::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} {}
  177.     catch {optTest -fL} msg
  178.     set msg
  179. } {ambigous option "-fL", choose from:
  180.     -flag1xyz boolflag (false) 
  181.     -flag2xyz boolflag (false) 
  182.     -flag3xyz boolflag (false) }
  183.  
  184. test opt-10.2 {non ambigous flags} {
  185.     ::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} {
  186.     return $flag2xyz
  187.     }
  188.     optTest -fLaG2
  189. } 1
  190.  
  191.  
  192. # medium size overall test example: (defined once)
  193. ::tcl::OptProc optTest {
  194.     {cmd -choice {print save delete} "sub command to choose"}
  195.     {-allowBoing -boolean true}
  196.     {arg2 -string "this is help"}
  197.     {?arg3? 7 "optional number"}
  198.     {-moreflags}
  199. } {
  200.     list $cmd $allowBoing $arg2 $arg3 $moreflags
  201. }
  202.  
  203. test opt-10.3 {medium size overall test} {
  204.     list [catch {optTest} msg] $msg
  205. } {1 {no value given for parameter "cmd" (use -help for full usage) :
  206.     cmd choice (print save delete) sub command to choose}}
  207.  
  208.  
  209. test opt-10.4 {medium size overall test} {
  210.     list [catch {optTest -help} msg] $msg
  211. } {1 {Usage information:
  212.     Var/FlagName Type     Value   Help
  213.     ------------ ----     -----   ----
  214.     ( -help                       gives this help )
  215.     cmd          choice   (print save delete) sub command to choose
  216.     -allowBoing  boolean  (true)  
  217.     arg2         string   ()      this is help
  218.     ?arg3?       int      (7)     optional number
  219.     -moreflags   boolflag (false) }}
  220.  
  221. test opt-10.5 {medium size overall test} {
  222.     optTest save tst
  223. } {save 1 tst 7 0}
  224.  
  225. test opt-10.6 {medium size overall test} {
  226.     optTest save -allowBoing false -- 8
  227. } {save 0 8 7 0}
  228.  
  229. test opt-10.7 {medium size overall test} {
  230.     optTest save tst -m --
  231. } {save 1 tst 7 1}
  232.  
  233. test opt-10.8 {medium size overall test} {
  234.     list [catch {optTest save tst foo} msg] [lindex [split $msg "\n"] 0]
  235. } {1 {too many arguments (unexpected argument(s): foo), usage:}}
  236.  
  237.