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 / info.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  16.7 KB  |  577 lines  |  [TEXT/ALFA]
  1. # Commands covered:  info
  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-1994 The Regents of the University of California.
  8. # Copyright (c) 1994-1995 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: @(#) info.test 1.39 97/08/01 11:10:24
  14.  
  15. if {[string compare test [info procs test]] == 1} then {source defs}
  16.  
  17. test info-1.1 {info args option} {
  18.     proc t1 {a bbb c} {return foo}
  19.     info args t1
  20. } {a bbb c}
  21. test info-1.2 {info args option} {
  22.     proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
  23.     info a t1
  24. } {a bbb c args}
  25. test info-1.3 {info args option} {
  26.     proc t1 "" {return foo}
  27.     info args t1
  28. } {}
  29. test info-1.4 {info args option} {
  30.     catch {rename t1 {}}
  31.     list [catch {info args t1} msg] $msg
  32. } {1 {"t1" isn't a procedure}}
  33. test info-1.5 {info args option} {
  34.     list [catch {info args set} msg] $msg
  35. } {1 {"set" isn't a procedure}}
  36. test info-1.6 {info args option} {
  37.     proc t1 {a b} {set c 123; set d $c}
  38.     t1 1 2
  39.     info args t1
  40. } {a b}
  41.  
  42. test info-2.1 {info body option} {
  43.     proc t1 {} {body of t1}
  44.     info body t1
  45. } {body of t1}
  46. test info-2.2 {info body option} {
  47.     list [catch {info body set} msg] $msg
  48. } {1 {"set" isn't a procedure}}
  49. test info-2.3 {info body option} {
  50.     list [catch {info args set 1} msg] $msg
  51. } {1 {wrong # args: should be "info args procname"}}
  52.  
  53. # "info cmdcount" is no longer accurate for compiled commands! The expected
  54. # result for info-3.1 used to be "3" and is now "1" since the "set"s have
  55. # been compiled away.
  56. test info-3.1 {info cmdcount option} {
  57.     set x [info cmdcount]
  58.     set y 12345
  59.     set z [info cm]
  60.     expr $z-$x
  61. } 1
  62. test info-3.2 {info body option} {
  63.     list [catch {info cmdcount 1} msg] $msg
  64. } {1 {wrong # args: should be "info cmdcount"}}
  65.  
  66. test info-4.1 {info commands option} {
  67.     proc t1 {} {}
  68.     proc t2 {} {}
  69.     set x " [info commands] "
  70.     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
  71.             [string match {* set *} $x] [string match {* list *} $x]
  72. } {1 1 1 1}
  73. test info-4.2 {info commands option} {
  74.     proc t1 {} {}
  75.     rename t1 {}
  76.     set x [info comm]
  77.     string match {* t1 *} $x
  78. } 0
  79. test info-4.3 {info commands option} {
  80.     proc _t1_ {} {}
  81.     proc _t2_ {} {}
  82.     info commands _t1_
  83. } _t1_
  84. test info-4.4 {info commands option} {
  85.     proc _t1_ {} {}
  86.     proc _t2_ {} {}
  87.     lsort [info commands _t*]
  88. } {_t1_ _t2_}
  89. catch {rename _t1_ {}}
  90. catch {rename _t2_ {}}
  91. test info-4.5 {info commands option} {
  92.     list [catch {info commands a b} msg] $msg
  93. } {1 {wrong # args: should be "info commands ?pattern?"}}
  94.  
  95. test info-5.1 {info complete option} {
  96.     info complete ""
  97. } 1
  98. test info-5.2 {info complete option} {
  99.     info complete "  \n"
  100. } 1
  101. test info-5.3 {info complete option} {
  102.     info complete "abc def"
  103. } 1
  104. test info-5.4 {info complete option} {
  105.     info complete "a b c d e f \t\n"
  106. } 1
  107. test info-5.5 {info complete option} {
  108.     info complete {a b c"d}
  109. } 1
  110. test info-5.6 {info complete option} {
  111.     info complete {a b "c d" e}
  112. } 1
  113. test info-5.7 {info complete option} {
  114.     info complete {a b "c d"}
  115. } 1
  116. test info-5.8 {info complete option} {
  117.     info complete {a b "c d"}
  118. } 1
  119. test info-5.9 {info complete option} {
  120.     info complete {a b "c d}
  121. } 0
  122. test info-5.10 {info complete option} {
  123.     info complete {a b "}
  124. } 0
  125. test info-5.11 {info complete option} {
  126.     info complete {a b "cd"xyz}
  127. } 1
  128. test info-5.12 {info complete option} {
  129.     info complete {a b "c $d() d"}
  130. } 1
  131. test info-5.13 {info complete option} {
  132.     info complete {a b "c $dd("}
  133. } 0
  134. test info-5.14 {info complete option} {
  135.     info complete {a b "c \"}
  136. } 0
  137. test info-5.15 {info complete option} {
  138.     info complete {a b "c [d e f]"}
  139. } 1
  140. test info-5.16 {info complete option} {
  141.     info complete {a b "c [d e f] g"}
  142. } 1
  143. test info-5.17 {info complete option} {
  144.     info complete {a b "c [d e f"}
  145. } 0
  146. test info-5.18 {info complete option} {
  147.     info complete {a {b c d} e}
  148. } 1
  149. test info-5.19 {info complete option} {
  150.     info complete {a {b c d}}
  151. } 1
  152. test info-5.20 {info complete option} {
  153.     info complete "a b\{c d"
  154. } 1
  155. test info-5.21 {info complete option} {
  156.     info complete "a b \{c"
  157. } 0
  158. test info-5.22 {info complete option} {
  159.     info complete "a b \{c{ }"
  160. } 0
  161. test info-5.23 {info complete option} {
  162.     info complete "a b {c d e}xxx"
  163. } 1
  164. test info-5.24 {info complete option} {
  165.     info complete "a b {c \\\{d e}xxx"
  166. } 1
  167. test info-5.25 {info complete option} {
  168.     info complete {a b [ab cd ef]}
  169. } 1
  170. test info-5.26 {info complete option} {
  171.     info complete {a b x[ab][cd][ef] gh}
  172. } 1
  173. test info-5.27 {info complete option} {
  174.     info complete {a b x[ab][cd[ef] gh}
  175. } 0
  176. test info-5.28 {info complete option} {
  177.     info complete {a b x[ gh}
  178. } 0
  179. test info-5.29 {info complete option} {
  180.     info complete {[]]]}
  181. } 1
  182. test info-5.30 {info complete option} {
  183.     info complete {abc x$yyy}
  184. } 1
  185. test info-5.31 {info complete option} {
  186.     info complete "abc x\${abc\[\\d} xyz"
  187. } 1
  188. test info-5.32 {info complete option} {
  189.     info complete "abc x\$\{ xyz"
  190. } 0
  191. test info-5.33 {info complete option} {
  192.     info complete {word $a(xyz)}
  193. } 1
  194. test info-5.34 {info complete option} {
  195.     info complete {word $a(}
  196. } 0
  197. test info-5.35 {info complete option} {
  198.     info complete "set a \\\n"
  199. } 0
  200. test info-5.36 {info complete option} {
  201.     info complete "set a \\n "
  202. } 1
  203. test info-5.37 {info complete option} {
  204.     info complete "set a \\"
  205. } 1
  206. test info-5.38 {info complete option} {
  207.     info complete "foo \\\n\{"
  208. } 0
  209. test info-5.39 {info complete option} {
  210.     info complete " # \{"
  211. } 1
  212. test info-5.40 {info complete option} {
  213.     info complete "foo bar;# \{"
  214. } 1
  215. test info-5.41 {info complete option} {
  216.     info complete "a\nb\n# \{\n# \{\nc\n"
  217. } 1
  218. test info-5.42 {info complete option} {
  219.     info complete "#Incomplete comment\\\n"
  220. } 0
  221. test info-5.43 {info complete option} {
  222.     info complete "#Incomplete comment\\\nBut now it's complete.\n"
  223. } 1
  224. test info-5.44 {info complete option} {
  225.     info complete "# Complete comment\\\\\n"
  226. } 1
  227. test info-5.45 {info complete option} {
  228.     info complete "abc\\\n def"
  229. } 1
  230. test info-5.46 {info complete option} {
  231.     info complete "abc\\\n "
  232. } 1
  233. test info-5.47 {info complete option} {
  234.     info complete "abc\\\n"
  235. } 0
  236.  
  237. test info-6.1 {info default option} {
  238.     proc t1 {a b {c d} {e "long default value"}} {}
  239.     info default t1 a value
  240. } 0
  241. test info-6.2 {info default option} {
  242.     proc t1 {a b {c d} {e "long default value"}} {}
  243.     set value 12345
  244.     info d t1 a value
  245.     set value
  246. } {}
  247. test info-6.3 {info default option} {
  248.     proc t1 {a b {c d} {e "long default value"}} {}
  249.     info default t1 c value
  250. } 1
  251. test info-6.4 {info default option} {
  252.     proc t1 {a b {c d} {e "long default value"}} {}
  253.     set value 12345
  254.     info default t1 c value
  255.     set value
  256. } d
  257. test info-6.5 {info default option} {
  258.     proc t1 {a b {c d} {e "long default value"}} {}
  259.     set value 12345
  260.     set x [info default t1 e value]
  261.     list $x $value
  262. } {1 {long default value}}
  263. test info-6.6 {info default option} {
  264.     list [catch {info default a b} msg] $msg
  265. } {1 {wrong # args: should be "info default procname arg varname"}}
  266. test info-6.7 {info default option} {
  267.     list [catch {info default _nonexistent_ a b} msg] $msg
  268. } {1 {"_nonexistent_" isn't a procedure}}
  269. test info-6.8 {info default option} {
  270.     proc t1 {a b} {}
  271.     list [catch {info default t1 x value} msg] $msg
  272. } {1 {procedure "t1" doesn't have an argument "x"}}
  273. test info-6.9 {info default option} {
  274.     catch {unset a}
  275.     set a(0) 88
  276.     proc t1 {a b} {}
  277.     list [catch {info default t1 a a} msg] $msg
  278. } {1 {couldn't store default value in variable "a"}}
  279. test info-6.10 {info default option} {
  280.     catch {unset a}
  281.     set a(0) 88
  282.     proc t1 {{a 18} b} {}
  283.     list [catch {info default t1 a a} msg] $msg
  284. } {1 {couldn't store default value in variable "a"}}
  285. catch {unset a}
  286.  
  287. test info-7.1 {info exists option} {
  288.     set value foo
  289.     info exists value
  290. } 1
  291. catch {unset _nonexistent_}
  292. test info-7.2 {info exists option} {
  293.     info exists _nonexistent_
  294. } 0
  295. test info-7.3 {info exists option} {
  296.     proc t1 {x} {return [info exists x]}
  297.     t1 2
  298. } 1
  299. test info-7.4 {info exists option} {
  300.     proc t1 {x} {
  301.         global _nonexistent_
  302.         return [info exists _nonexistent_]
  303.     }
  304.     t1 2
  305. } 0
  306. test info-7.5 {info exists option} {
  307.     proc t1 {x} {
  308.         set y 47
  309.         return [info exists y]
  310.     }
  311.     t1 2
  312. } 1
  313. test info-7.6 {info exists option} {
  314.     proc t1 {x} {return [info exists value]}
  315.     t1 2
  316. } 0
  317. test info-7.7 {info exists option} {
  318.     catch {unset x}
  319.     set x(2) 44
  320.     list [info exists x] [info exists x(1)] [info exists x(2)]
  321. } {1 0 1}
  322. catch {unset x}
  323. test info-7.8 {info exists option} {
  324.     list [catch {info exists} msg] $msg
  325. } {1 {wrong # args: should be "info exists varName"}}
  326. test info-7.9 {info exists option} {
  327.     list [catch {info exists 1 2} msg] $msg
  328. } {1 {wrong # args: should be "info exists varName"}}
  329.  
  330. test info-8.1 {info globals option} {
  331.     set x 1
  332.     set y 2
  333.     set value 23
  334.     set a " [info globals] "
  335.     list [string match {* x *} $a] [string match {* y *} $a] \
  336.             [string match {* value *} $a] [string match {* _foobar_ *} $a]
  337. } {1 1 1 0}
  338. test info-8.2 {info globals option} {
  339.     set _xxx1 1
  340.     set _xxx2 2
  341.     lsort [info g _xxx*]
  342. } {_xxx1 _xxx2}
  343. test info-8.3 {info globals option} {
  344.     list [catch {info globals 1 2} msg] $msg
  345. } {1 {wrong # args: should be "info globals ?pattern?"}}
  346.  
  347. test info-9.1 {info level option} {
  348.     info level
  349. } 0
  350. test info-9.2 {info level option} {
  351.     proc t1 {a b} {
  352.         set x [info le]
  353.         set y [info level 1]
  354.         list $x $y
  355.     }
  356.     t1 146 testString
  357. } {1 {t1 146 testString}}
  358. test info-9.3 {info level option} {
  359.     proc t1 {a b} {
  360.         t2 [expr $a*2] $b
  361.     }
  362.     proc t2 {x y} {
  363.         list [info level] [info level 1] [info level 2] [info level -1] \
  364.                 [info level 0]
  365.     }
  366.     t1 146 {a {b c} {{{c}}}}
  367. } {2 {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}} {t1 146 {a {b c} {{{c}}}}} {t2 292 {a {b c} {{{c}}}}}}
  368. test info-9.4 {info level option} {
  369.     proc t1 {} {
  370.         set x [info level]
  371.         set y [info level 1]
  372.         list $x $y
  373.     }
  374.     t1
  375. } {1 t1}
  376. test info-9.5 {info level option} {
  377.     list [catch {info level 1 2} msg] $msg
  378. } {1 {wrong # args: should be "info level ?number?"}}
  379. test info-9.6 {info level option} {
  380.     list [catch {info level 123a} msg] $msg
  381. } {1 {expected integer but got "123a"}}
  382. test info-9.7 {info level option} {
  383.     list [catch {info level 0} msg] $msg
  384. } {1 {bad level "0"}}
  385. test info-9.8 {info level option} {
  386.     proc t1 {} {info level -1}
  387.     list [catch {t1} msg] $msg
  388. } {1 {bad level "-1"}}
  389. test info-9.9 {info level option} {
  390.     proc t1 {x} {info level $x}
  391.     list [catch {t1 -3} msg] $msg
  392. } {1 {bad level "-3"}}
  393.  
  394. set savedLibrary $tcl_library
  395. test info-10.1 {info library option} {
  396.     list [catch {info library x} msg] $msg
  397. } {1 {wrong # args: should be "info library"}}
  398. test info-10.2 {info library option} {
  399.     set tcl_library 12345
  400.     info library
  401. } {12345}
  402. test info-10.3 {info library option} {
  403.     unset tcl_library
  404.     list [catch {info library} msg] $msg
  405. } {1 {no library has been specified for Tcl}}
  406. set tcl_library $savedLibrary
  407.  
  408. test info-11.1 {info loaded option} {
  409.     list [catch {info loaded a b} msg] $msg
  410. } {1 {wrong # args: should be "info loaded ?interp?"}}
  411. test info-11.2 {info loaded option} {
  412.     list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
  413. } {0 1 {couldn't find slave interpreter named "gorp"}}
  414.  
  415. test info-12.1 {info locals option} {
  416.     set a 22
  417.     proc t1 {x y} {
  418.         set b 13
  419.         set c testing
  420.         global a
  421.         return [info locals]
  422.     }
  423.     lsort [t1 23 24]
  424. } {b c x y}
  425. test info-12.2 {info locals option} {
  426.     proc t1 {x y} {
  427.         set xx1 2
  428.         set xx2 3
  429.         set y 4
  430.         return [info loc x*]
  431.     }
  432.     lsort [t1 2 3]
  433. } {x xx1 xx2}
  434. test info-12.3 {info locals option} {
  435.     list [catch {info locals 1 2} msg] $msg
  436. } {1 {wrong # args: should be "info locals ?pattern?"}}
  437. test info-12.4 {info locals option} {
  438.     info locals
  439. } {}
  440. test info-12.5 {info locals option} {
  441.     proc t1 {} {return [info locals]}
  442.     t1
  443. } {}
  444. test info-12.6 {info locals vs unset compiled locals} {
  445.     proc t1 {lst} {
  446.         foreach $lst $lst {}
  447.         unset lst
  448.         return [info locals]
  449.     }
  450.     lsort [t1 {a b c c d e f}]
  451. } {a b c d e f}
  452.  
  453. test info-13.1 {info nameofexecutable option} {
  454.     list [catch {info nameofexecutable foo} msg] $msg
  455. } {1 {wrong # args: should be "info nameofexecutable"}}
  456.  
  457. test info-14.1 {info patchlevel option} {
  458.     set a [info patchlevel]
  459.     regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
  460. } 1
  461. test info-14.2 {info patchlevel option} {
  462.     list [catch {info patchlevel a} msg] $msg
  463. } {1 {wrong # args: should be "info patchlevel"}}
  464. test info-14.3 {info patchlevel option} {
  465.     set t $tcl_patchLevel
  466.     unset tcl_patchLevel
  467.     set result [list [catch {info patchlevel} msg] $msg]
  468.     set tcl_patchLevel $t
  469.     set result
  470. } {1 {can't read "tcl_patchLevel": no such variable}}
  471.  
  472. test info-15.1 {info procs option} {
  473.     proc t1 {} {}
  474.     proc t2 {} {}
  475.     set x " [info procs] "
  476.     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
  477.             [string match {* _undefined_ *} $x]
  478. } {1 1 0}
  479. test info-15.2 {info procs option} {
  480.     proc _tt1 {} {}
  481.     proc _tt2 {} {}
  482.     lsort [info pr _tt*]
  483. } {_tt1 _tt2}
  484. catch {rename _tt1 {}}
  485. catch {rename _tt2 {}}
  486. test info-15.3 {info procs option} {
  487.     list [catch {info procs 2 3} msg] $msg
  488. } {1 {wrong # args: should be "info procs ?pattern?"}}
  489.  
  490. set self info.test
  491. if {$tcl_platform(os) == "Win32s"} {
  492.     set self info~1.tes
  493. }
  494.  
  495. test info-16.1 {info script option} {
  496.     list [catch {info script x} msg] $msg
  497. } {1 {wrong # args: should be "info script"}}
  498. test info-16.2 {info script option} {
  499.     file tail [info sc]
  500. } $self
  501. removeFile gorp.info
  502. makeFile "info script\n" gorp.info
  503. test info-16.3 {info script option} {
  504.     list [source gorp.info] [file tail [info script]]
  505. } [list gorp.info $self]
  506. test info-16.4 {resetting "info script" after errors} {
  507.     catch {source ~_nobody_/foo}
  508.     file tail [info script]
  509. } $self
  510. test info-16.5 {resetting "info script" after errors} {
  511.     catch {source _nonexistent_}
  512.     file tail [info script]
  513. } $self
  514. removeFile gorp.info
  515.  
  516. test info-17.1 {info sharedlibextension option} {
  517.     list [catch {info sharedlibextension foo} msg] $msg
  518. } {1 {wrong # args: should be "info sharedlibextension"}}
  519.  
  520. test info-18.1 {info tclversion option} {
  521.     set x [info tclversion]
  522.     scan $x "%d.%d%c" a b c
  523. } 2
  524. test info-18.2 {info tclversion option} {
  525.     list [catch {info t 2} msg] $msg
  526. } {1 {wrong # args: should be "info tclversion"}}
  527. test info-18.3 {info tclversion option} {
  528.     set t $tcl_version
  529.     unset tcl_version
  530.     set result [list [catch {info tclversion} msg] $msg]
  531.     set tcl_version $t
  532.     set result
  533. } {1 {can't read "tcl_version": no such variable}}
  534.  
  535. test info-19.1 {info vars option} {
  536.     set a 1
  537.     set b 2
  538.     proc t1 {x y} {
  539.         global a b
  540.         set c 33
  541.         return [info vars]
  542.     }
  543.     lsort [t1 18 19]
  544. } {a b c x y}
  545. test info-19.2 {info vars option} {
  546.     set xxx1 1
  547.     set xxx2 2
  548.     proc t1 {xxa y} {
  549.         global xxx1 xxx2
  550.         set c 33
  551.         return [info vars x*]
  552.     }
  553.     lsort [t1 18 19]
  554. } {xxa xxx1 xxx2}
  555. test info-19.3 {info vars option} {
  556.     lsort [info vars]
  557. } [lsort [info globals]]
  558. test info-19.4 {info vars option} {
  559.     list [catch {info vars a b} msg] $msg
  560. } {1 {wrong # args: should be "info vars ?pattern?"}}
  561.  
  562. test info-20.1 {miscellaneous error conditions} {
  563.     list [catch {info} msg] $msg
  564. } {1 {wrong # args: should be "info option ?arg arg ...?"}}
  565. test info-20.2 {miscellaneous error conditions} {
  566.     list [catch {info gorp} msg] $msg
  567. } {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
  568. test info-20.3 {miscellaneous error conditions} {
  569.     list [catch {info c} msg] $msg
  570. } {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
  571. test info-20.4 {miscellaneous error conditions} {
  572.     list [catch {info l} msg] $msg
  573. } {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
  574. test info-20.5 {miscellaneous error conditions} {
  575.     list [catch {info s} msg] $msg
  576. } {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
  577.