home *** CD-ROM | disk | FTP | other *** search
/ Serving the Web / ServingTheWeb1995.disc1of1.iso / linux / slacksrce / tcl / tcl+tk+t / tcl7.3l1 / tcl7 / tcl7.3 / tests / info.test < prev    next >
Encoding:
Text File  |  1993-10-13  |  15.1 KB  |  525 lines
  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-1993 The Regents of the University of California.
  8. # All rights reserved.
  9. #
  10. # Permission is hereby granted, without written agreement and without
  11. # license or royalty fees, to use, copy, modify, and distribute this
  12. # software and its documentation for any purpose, provided that the
  13. # above copyright notice and the following two paragraphs appear in
  14. # all copies of this software.
  15. #
  16. # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  17. # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  18. # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  19. # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  20. #
  21. # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  22. # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  23. # AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  24. # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  25. # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  26. #
  27. # $Header: /user6/ouster/tcl/tests/RCS/info.test,v 1.17 93/10/13 13:02:02 ouster Exp $ (Berkeley)
  28.  
  29. if {[string compare test [info procs test]] == 1} then {source defs}
  30.  
  31. test info-1.1 {info args option} {
  32.     proc t1 {a bbb c} {return foo}
  33.     info args t1
  34. } {a bbb c}
  35. test info-1.2 {info args option} {
  36.     proc t1 {{a default1} {bbb default2} {c default3} args} {return foo}
  37.     info a t1
  38. } {a bbb c args}
  39. test info-1.3 {info args option} {
  40.     proc t1 "" {return foo}
  41.     info args t1
  42. } {}
  43. test info-1.4 {info args option} {
  44.     catch {rename t1 {}}
  45.     list [catch {info args t1} msg] $msg
  46. } {1 {"t1" isn't a procedure}}
  47. test info-1.5 {info args option} {
  48.     list [catch {info args set} msg] $msg
  49. } {1 {"set" isn't a procedure}}
  50.  
  51. test info-2.1 {info body option} {
  52.     proc t1 {} {body of t1}
  53.     info body t1
  54. } {body of t1}
  55. test info-2.2 {info body option} {
  56.     list [catch {info body set} msg] $msg
  57. } {1 {"set" isn't a procedure}}
  58. test info-2.3 {info body option} {
  59.     list [catch {info args set 1} msg] $msg
  60. } {1 {wrong # args: should be "info args procname"}}
  61.  
  62. test info-3.1 {info cmdcount option} {
  63.     set x [info cmdcount]
  64.     set y 12345
  65.     set z [info cm]
  66.     expr $z-$x
  67. } 3
  68. test info-3.2 {info body option} {
  69.     list [catch {info cmdcount 1} msg] $msg
  70. } {1 {wrong # args: should be "info cmdcount"}}
  71.  
  72. test info-4.1 {info commands option} {
  73.     proc t1 {} {}
  74.     proc t2 {} {}
  75.     set x " [info commands] "
  76.     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
  77.             [string match {* set *} $x] [string match {* list *} $x]
  78. } {1 1 1 1}
  79. test info-4.2 {info commands option} {
  80.     proc t1 {} {}
  81.     rename t1 {}
  82.     set x [info comm]
  83.     string match {* t1 *} $x
  84. } 0
  85. test info-4.3 {info commands option} {
  86.     proc _t1_ {} {}
  87.     proc _t2_ {} {}
  88.     info commands _t1_
  89. } _t1_
  90. test info-4.4 {info commands option} {
  91.     proc _t1_ {} {}
  92.     proc _t2_ {} {}
  93.     lsort [info commands _t*]
  94. } {_t1_ _t2_}
  95. catch {rename _t1_ {}}
  96. catch {rename _t2_ {}}
  97. test info-4.5 {info commands option} {
  98.     list [catch {info commands a b} msg] $msg
  99. } {1 {wrong # args: should be "info commands [pattern]"}}
  100.  
  101. test info-5.1 {info complete option} {
  102.     info complete ""
  103. } 1
  104. test info-5.2 {info complete option} {
  105.     info complete "  \n"
  106. } 1
  107. test info-5.3 {info complete option} {
  108.     info complete "abc def"
  109. } 1
  110. test info-5.4 {info complete option} {
  111.     info complete "a b c d e f \t\n"
  112. } 1
  113. test info-5.5 {info complete option} {
  114.     info complete {a b c"d}
  115. } 1
  116. test info-5.6 {info complete option} {
  117.     info complete {a b "c d" e}
  118. } 1
  119. test info-5.7 {info complete option} {
  120.     info complete {a b "c d"}
  121. } 1
  122. test info-5.8 {info complete option} {
  123.     info complete {a b "c d"}
  124. } 1
  125. test info-5.9 {info complete option} {
  126.     info complete {a b "c d}
  127. } 0
  128. test info-5.10 {info complete option} {
  129.     info complete {a b "}
  130. } 0
  131. test info-5.11 {info complete option} {
  132.     info complete {a b "cd"xyz}
  133. } 1
  134. test info-5.12 {info complete option} {
  135.     info complete {a b "c $d() d"}
  136. } 1
  137. test info-5.13 {info complete option} {
  138.     info complete {a b "c $dd("}
  139. } 0
  140. test info-5.14 {info complete option} {
  141.     info complete {a b "c \"}
  142. } 0
  143. test info-5.15 {info complete option} {
  144.     info complete {a b "c [d e f]"}
  145. } 1
  146. test info-5.16 {info complete option} {
  147.     info complete {a b "c [d e f] g"}
  148. } 1
  149. test info-5.17 {info complete option} {
  150.     info complete {a b "c [d e f"}
  151. } 0
  152. test info-5.18 {info complete option} {
  153.     info complete {a {b c d} e}
  154. } 1
  155. test info-5.19 {info complete option} {
  156.     info complete {a {b c d}}
  157. } 1
  158. test info-5.20 {info complete option} {
  159.     info complete "a b\{c d"
  160. } 1
  161. test info-5.21 {info complete option} {
  162.     info complete "a b \{c"
  163. } 0
  164. test info-5.22 {info complete option} {
  165.     info complete "a b \{c{ }"
  166. } 0
  167. test info-5.23 {info complete option} {
  168.     info complete "a b {c d e}xxx"
  169. } 1
  170. test info-5.24 {info complete option} {
  171.     info complete "a b {c \\\{d e}xxx"
  172. } 1
  173. test info-5.25 {info complete option} {
  174.     info complete {a b [ab cd ef]}
  175. } 1
  176. test info-5.26 {info complete option} {
  177.     info complete {a b x[ab][cd][ef] gh}
  178. } 1
  179. test info-5.27 {info complete option} {
  180.     info complete {a b x[ab][cd[ef] gh}
  181. } 0
  182. test info-5.28 {info complete option} {
  183.     info complete {a b x[ gh}
  184. } 0
  185. test info-5.29 {info complete option} {
  186.     info complete {[]]]}
  187. } 1
  188. test info-5.30 {info complete option} {
  189.     info complete {abc x$yyy}
  190. } 1
  191. test info-5.31 {info complete option} {
  192.     info complete "abc x\${abc\[\\d} xyz"
  193. } 1
  194. test info-5.32 {info complete option} {
  195.     info complete "abc x\$\{ xyz"
  196. } 0
  197. test info-5.33 {info complete option} {
  198.     info complete {word $a(xyz)}
  199. } 1
  200. test info-5.34 {info complete option} {
  201.     info complete {word $a(}
  202. } 0
  203. test info-5.35 {info complete option} {
  204.     info complete "set a \\\n"
  205. } 0
  206. test info-5.36 {info complete option} {
  207.     info complete "set a \\n "
  208. } 1
  209. test info-5.37 {info complete option} {
  210.     info complete "set a \\"
  211. } 1
  212. test info-5.38 {info complete option} {
  213.     info complete "foo \\\n\{"
  214. } 0
  215. test info-5.39 {info complete option} {
  216.     info complete " # \{"
  217. } 1
  218. test info-5.40 {info complete option} {
  219.     info complete "foo bar;# \{"
  220. } 1
  221. test info-5.41 {info complete option} {
  222.     info complete "a\nb\n# \{\n# \{\nc\n"
  223. } 1
  224.  
  225. test info-6.1 {info default option} {
  226.     proc t1 {a b {c d} {e "long default value"}} {}
  227.     info default t1 a value
  228. } 0
  229. test info-6.2 {info default option} {
  230.     proc t1 {a b {c d} {e "long default value"}} {}
  231.     set value 12345
  232.     info d t1 a value
  233.     set value
  234. } {}
  235. test info-6.3 {info default option} {
  236.     proc t1 {a b {c d} {e "long default value"}} {}
  237.     info default t1 c value
  238. } 1
  239. test info-6.4 {info default option} {
  240.     proc t1 {a b {c d} {e "long default value"}} {}
  241.     set value 12345
  242.     info default t1 c value
  243.     set value
  244. } d
  245. test info-6.5 {info default option} {
  246.     proc t1 {a b {c d} {e "long default value"}} {}
  247.     set value 12345
  248.     set x [info default t1 e value]
  249.     list $x $value
  250. } {1 {long default value}}
  251. test info-6.6 {info default option} {
  252.     list [catch {info default a b} msg] $msg
  253. } {1 {wrong # args: should be "info default procname arg varname"}}
  254. test info-6.7 {info default option} {
  255.     list [catch {info default _nonexistent_ a b} msg] $msg
  256. } {1 {"_nonexistent_" isn't a procedure}}
  257. test info-6.8 {info default option} {
  258.     proc t1 {a b} {}
  259.     list [catch {info default t1 x value} msg] $msg
  260. } {1 {procedure "t1" doesn't have an argument "x"}}
  261. test info-6.9 {info default option} {
  262.     catch {unset a}
  263.     set a(0) 88
  264.     proc t1 {a b} {}
  265.     list [catch {info default t1 a a} msg] $msg
  266. } {1 {couldn't store default value in variable "a"}}
  267. test info-6.10 {info default option} {
  268.     catch {unset a}
  269.     set a(0) 88
  270.     proc t1 {{a 18} b} {}
  271.     list [catch {info default t1 a a} msg] $msg
  272. } {1 {couldn't store default value in variable "a"}}
  273. catch {unset a}
  274.  
  275. test info-7.1 {info exists option} {
  276.     set value foo
  277.     info exists value
  278. } 1
  279. catch {unset _nonexistent_}
  280. test info-7.2 {info exists option} {
  281.     info exists _nonexistent_
  282. } 0
  283. test info-7.3 {info exists option} {
  284.     proc t1 {x} {return [info exists x]}
  285.     t1 2
  286. } 1
  287. test info-7.4 {info exists option} {
  288.     proc t1 {x} {
  289.         global _nonexistent_
  290.         return [info exists _nonexistent_]
  291.     }
  292.     t1 2
  293. } 0
  294. test info-7.5 {info exists option} {
  295.     proc t1 {x} {
  296.         set y 47
  297.         return [info exists y]
  298.     }
  299.     t1 2
  300. } 1
  301. test info-7.6 {info exists option} {
  302.     proc t1 {x} {return [info exists value]}
  303.     t1 2
  304. } 0
  305. test info-7.7 {info exists option} {
  306.     catch {unset x}
  307.     set x(2) 44
  308.     list [info exists x] [info exists x(1)] [info exists x(2)]
  309. } {1 0 1}
  310. catch {unset x}
  311. test info-7.8 {info exists option} {
  312.     list [catch {info exists} msg] $msg
  313. } {1 {wrong # args: should be "info exists varName"}}
  314. test info-7.9 {info exists option} {
  315.     list [catch {info exists 1 2} msg] $msg
  316. } {1 {wrong # args: should be "info exists varName"}}
  317.  
  318. test info-8.1 {info globals option} {
  319.     set x 1
  320.     set y 2
  321.     set value 23
  322.     set a " [info globals] "
  323.     list [string match {* x *} $a] [string match {* y *} $a] \
  324.             [string match {* value *} $a] [string match {* _foobar_ *} $a]
  325. } {1 1 1 0}
  326. test info-8.2 {info globals option} {
  327.     set _xxx1 1
  328.     set _xxx2 2
  329.     lsort [info g _xxx*]
  330. } {_xxx1 _xxx2}
  331. test info-8.3 {info globals option} {
  332.     list [catch {info globals 1 2} msg] $msg
  333. } {1 {wrong # args: should be "info globals [pattern]"}}
  334.  
  335. test info-9.1 {info level option} {
  336.     info level
  337. } 0
  338. test info-9.2 {info level option} {
  339.     proc t1 {a b} {
  340.         set x [info le]
  341.         set y [info level 1]
  342.         list $x $y
  343.     }
  344.     t1 146 testString
  345. } {1 {t1 146 testString}}
  346. test info-9.3 {info level option} {
  347.     proc t1 {a b} {
  348.         t2 [expr $a*2] $b
  349.     }
  350.     proc t2 {x y} {
  351.         list [info level] [info level 1] [info level 2] [info level -1] \
  352.                 [info level 0]
  353.     }
  354.     t1 146 {a {b c} {{{c}}}}
  355. } {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}}}}}}
  356. test info-9.4 {info level option} {
  357.     proc t1 {} {
  358.         set x [info level]
  359.         set y [info level 1]
  360.         list $x $y
  361.     }
  362.     t1
  363. } {1 t1}
  364. test info-9.5 {info level option} {
  365.     list [catch {info level 1 2} msg] $msg
  366. } {1 {wrong # args: should be "info level [number]"}}
  367. test info-9.6 {info level option} {
  368.     list [catch {info level 123a} msg] $msg
  369. } {1 {expected integer but got "123a"}}
  370. test info-9.7 {info level option} {
  371.     list [catch {info level 0} msg] $msg
  372. } {1 {bad level "0"}}
  373. test info-9.8 {info level option} {
  374.     proc t1 {} {info level -1}
  375.     list [catch {t1} msg] $msg
  376. } {1 {bad level "-1"}}
  377. test info-9.9 {info level option} {
  378.     proc t1 {x} {info level $x}
  379.     list [catch {t1 -3} msg] $msg
  380. } {1 {bad level "-3"}}
  381.  
  382. test info-10.1 {info library option} {
  383.     list [catch {info library x} msg] $msg
  384. } {1 {wrong # args: should be "info library"}}
  385. # The following check can only be done at Berkeley, where the exact
  386. # location of the library is known.
  387.  
  388. if $atBerkeley {
  389.     test info-10.2 {info library option} {
  390.     info li
  391.     } /users/ouster/tcl/library
  392.     test info-10.3 {info library option} {
  393.     set env(TCL_LIBRARY) test_value
  394.     set result [info library]
  395.     unset env(TCL_LIBRARY)
  396.     list $result [info library]
  397.     } {test_value /users/ouster/tcl/library}
  398. }
  399.  
  400. test info-11.1 {info locals option} {
  401.     set a 22
  402.     proc t1 {x y} {
  403.         set b 13
  404.         set c testing
  405.         global a
  406.         return [info locals]
  407.     }
  408.     lsort [t1 23 24]
  409. } {b c x y}
  410. test info-11.2 {info locals option} {
  411.     proc t1 {x y} {
  412.         set xx1 2
  413.         set xx2 3
  414.         set y 4
  415.         return [info lo x*]
  416.     }
  417.     lsort [t1 2 3]
  418. } {x xx1 xx2}
  419. test info-11.3 {info locals option} {
  420.     list [catch {info locals 1 2} msg] $msg
  421. } {1 {wrong # args: should be "info locals [pattern]"}}
  422. test info-11.4 {info locals option} {
  423.     info locals
  424. } {}
  425. test info-11.5 {info locals option} {
  426.     proc t1 {} {return [info locals]}
  427.     t1
  428. } {}
  429.  
  430. test info-12.1 {info patchlevel option} {
  431.     set a [info patchlevel]
  432.     incr a 2
  433.     expr $a-[info patchlevel]
  434. } 2
  435. test info-12.2 {info patchlevel option} {
  436.     list [catch {info patchlevel a} msg] $msg
  437. } {1 {wrong # args: should be "info patchlevel"}}
  438.  
  439. test info-13.1 {info procs option} {
  440.     proc t1 {} {}
  441.     proc t2 {} {}
  442.     set x " [info procs] "
  443.     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
  444.             [string match {* _undefined_ *} $x]
  445. } {1 1 0}
  446. test info-13.2 {info procs option} {
  447.     proc _tt1 {} {}
  448.     proc _tt2 {} {}
  449.     lsort [info pr _tt*]
  450. } {_tt1 _tt2}
  451. catch {rename _tt1 {}}
  452. catch {rename _tt2 {}}
  453. test info-13.3 {info procs option} {
  454.     list [catch {info procs 2 3} msg] $msg
  455. } {1 {wrong # args: should be "info procs [pattern]"}}
  456.  
  457. test info-14.1 {info script option} {
  458.     list [catch {info script x} msg] $msg
  459. } {1 {wrong # args: should be "info script"}}
  460. test info-14.2 {info script option} {
  461.     file tail [info s]
  462. } info.test
  463. catch {exec rm -f gorp.info}
  464. exec cat > gorp.info << "info script\n"
  465. test info-14.3 {info script option} {
  466.     list [source gorp.info] [file tail [info script]]
  467. } {gorp.info info.test}
  468. test info-14.4 {resetting "info script" after errors} {
  469.     catch {source ~_nobody_/foo}
  470.     file tail [info script]
  471. } {info.test}
  472. test info-14.5 {resetting "info script" after errors} {
  473.     catch {source _nonexistent_}
  474.     file tail [info script]
  475. } {info.test}
  476. exec rm -f gorp.info
  477.  
  478. test info-15.1 {info tclversion option} {
  479.     set x [info tclversion]
  480.     scan $x "%d.%d%c" a b c
  481. } 2
  482. test info-15.2 {info tclversion option} {
  483.     list [catch {info t 2} msg] $msg
  484. } {1 {wrong # args: should be "info tclversion"}}
  485.  
  486. test info-16.1 {info vars option} {
  487.     set a 1
  488.     set b 2
  489.     proc t1 {x y} {
  490.         global a b
  491.         set c 33
  492.         return [info vars]
  493.     }
  494.     lsort [t1 18 19]
  495. } {a b c x y}
  496. test info-16.2 {info vars option} {
  497.     set xxx1 1
  498.     set xxx2 2
  499.     proc t1 {xxa y} {
  500.         global xxx1 xxx2
  501.         set c 33
  502.         return [info vars x*]
  503.     }
  504.     lsort [t1 18 19]
  505. } {xxa xxx1 xxx2}
  506. test info-16.3 {info vars option} {
  507.     lsort [info vars]
  508. } [lsort [info globals]]
  509. test info-16.4 {info vars option} {
  510.     list [catch {info vars a b} msg] $msg
  511. } {1 {wrong # args: should be "info vars [pattern]"}}
  512.  
  513. test info-17.1 {miscellaneous error conditions} {
  514.     list [catch {info} msg] $msg
  515. } {1 {wrong # args: should be "info option ?arg arg ...?"}}
  516. test info-17.2 {miscellaneous error conditions} {
  517.     list [catch {info gorp} msg] $msg
  518. } {1 {bad option "gorp": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, patchlevel, procs, script, tclversion, or vars}}
  519. test info-17.3 {miscellaneous error conditions} {
  520.     list [catch {info c} msg] $msg
  521. } {1 {bad option "c": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, patchlevel, procs, script, tclversion, or vars}}
  522. test info-17.4 {miscellaneous error conditions} {
  523.     list [catch {info l} msg] $msg
  524. } {1 {bad option "l": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, patchlevel, procs, script, tclversion, or vars}}
  525.