home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tcl7.4 / tests / info.test < prev    next >
Encoding:
Text File  |  1995-06-28  |  14.6 KB  |  520 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-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. # @(#) info.test 1.24 95/06/28 13:26:13
  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.  
  37. test info-2.1 {info body option} {
  38.     proc t1 {} {body of t1}
  39.     info body t1
  40. } {body of t1}
  41. test info-2.2 {info body option} {
  42.     list [catch {info body set} msg] $msg
  43. } {1 {"set" isn't a procedure}}
  44. test info-2.3 {info body option} {
  45.     list [catch {info args set 1} msg] $msg
  46. } {1 {wrong # args: should be "info args procname"}}
  47.  
  48. test info-3.1 {info cmdcount option} {
  49.     set x [info cmdcount]
  50.     set y 12345
  51.     set z [info cm]
  52.     expr $z-$x
  53. } 3
  54. test info-3.2 {info body option} {
  55.     list [catch {info cmdcount 1} msg] $msg
  56. } {1 {wrong # args: should be "info cmdcount"}}
  57.  
  58. test info-4.1 {info commands option} {
  59.     proc t1 {} {}
  60.     proc t2 {} {}
  61.     set x " [info commands] "
  62.     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
  63.             [string match {* set *} $x] [string match {* list *} $x]
  64. } {1 1 1 1}
  65. test info-4.2 {info commands option} {
  66.     proc t1 {} {}
  67.     rename t1 {}
  68.     set x [info comm]
  69.     string match {* t1 *} $x
  70. } 0
  71. test info-4.3 {info commands option} {
  72.     proc _t1_ {} {}
  73.     proc _t2_ {} {}
  74.     info commands _t1_
  75. } _t1_
  76. test info-4.4 {info commands option} {
  77.     proc _t1_ {} {}
  78.     proc _t2_ {} {}
  79.     lsort [info commands _t*]
  80. } {_t1_ _t2_}
  81. catch {rename _t1_ {}}
  82. catch {rename _t2_ {}}
  83. test info-4.5 {info commands option} {
  84.     list [catch {info commands a b} msg] $msg
  85. } {1 {wrong # args: should be "info commands [pattern]"}}
  86.  
  87. test info-5.1 {info complete option} {
  88.     info complete ""
  89. } 1
  90. test info-5.2 {info complete option} {
  91.     info complete "  \n"
  92. } 1
  93. test info-5.3 {info complete option} {
  94.     info complete "abc def"
  95. } 1
  96. test info-5.4 {info complete option} {
  97.     info complete "a b c d e f \t\n"
  98. } 1
  99. test info-5.5 {info complete option} {
  100.     info complete {a b c"d}
  101. } 1
  102. test info-5.6 {info complete option} {
  103.     info complete {a b "c d" e}
  104. } 1
  105. test info-5.7 {info complete option} {
  106.     info complete {a b "c d"}
  107. } 1
  108. test info-5.8 {info complete option} {
  109.     info complete {a b "c d"}
  110. } 1
  111. test info-5.9 {info complete option} {
  112.     info complete {a b "c d}
  113. } 0
  114. test info-5.10 {info complete option} {
  115.     info complete {a b "}
  116. } 0
  117. test info-5.11 {info complete option} {
  118.     info complete {a b "cd"xyz}
  119. } 1
  120. test info-5.12 {info complete option} {
  121.     info complete {a b "c $d() d"}
  122. } 1
  123. test info-5.13 {info complete option} {
  124.     info complete {a b "c $dd("}
  125. } 0
  126. test info-5.14 {info complete option} {
  127.     info complete {a b "c \"}
  128. } 0
  129. test info-5.15 {info complete option} {
  130.     info complete {a b "c [d e f]"}
  131. } 1
  132. test info-5.16 {info complete option} {
  133.     info complete {a b "c [d e f] g"}
  134. } 1
  135. test info-5.17 {info complete option} {
  136.     info complete {a b "c [d e f"}
  137. } 0
  138. test info-5.18 {info complete option} {
  139.     info complete {a {b c d} e}
  140. } 1
  141. test info-5.19 {info complete option} {
  142.     info complete {a {b c d}}
  143. } 1
  144. test info-5.20 {info complete option} {
  145.     info complete "a b\{c d"
  146. } 1
  147. test info-5.21 {info complete option} {
  148.     info complete "a b \{c"
  149. } 0
  150. test info-5.22 {info complete option} {
  151.     info complete "a b \{c{ }"
  152. } 0
  153. test info-5.23 {info complete option} {
  154.     info complete "a b {c d e}xxx"
  155. } 1
  156. test info-5.24 {info complete option} {
  157.     info complete "a b {c \\\{d e}xxx"
  158. } 1
  159. test info-5.25 {info complete option} {
  160.     info complete {a b [ab cd ef]}
  161. } 1
  162. test info-5.26 {info complete option} {
  163.     info complete {a b x[ab][cd][ef] gh}
  164. } 1
  165. test info-5.27 {info complete option} {
  166.     info complete {a b x[ab][cd[ef] gh}
  167. } 0
  168. test info-5.28 {info complete option} {
  169.     info complete {a b x[ gh}
  170. } 0
  171. test info-5.29 {info complete option} {
  172.     info complete {[]]]}
  173. } 1
  174. test info-5.30 {info complete option} {
  175.     info complete {abc x$yyy}
  176. } 1
  177. test info-5.31 {info complete option} {
  178.     info complete "abc x\${abc\[\\d} xyz"
  179. } 1
  180. test info-5.32 {info complete option} {
  181.     info complete "abc x\$\{ xyz"
  182. } 0
  183. test info-5.33 {info complete option} {
  184.     info complete {word $a(xyz)}
  185. } 1
  186. test info-5.34 {info complete option} {
  187.     info complete {word $a(}
  188. } 0
  189. test info-5.35 {info complete option} {
  190.     info complete "set a \\\n"
  191. } 0
  192. test info-5.36 {info complete option} {
  193.     info complete "set a \\n "
  194. } 1
  195. test info-5.37 {info complete option} {
  196.     info complete "set a \\"
  197. } 1
  198. test info-5.38 {info complete option} {
  199.     info complete "foo \\\n\{"
  200. } 0
  201. test info-5.39 {info complete option} {
  202.     info complete " # \{"
  203. } 1
  204. test info-5.40 {info complete option} {
  205.     info complete "foo bar;# \{"
  206. } 1
  207. test info-5.41 {info complete option} {
  208.     info complete "a\nb\n# \{\n# \{\nc\n"
  209. } 1
  210.  
  211. test info-6.1 {info default option} {
  212.     proc t1 {a b {c d} {e "long default value"}} {}
  213.     info default t1 a value
  214. } 0
  215. test info-6.2 {info default option} {
  216.     proc t1 {a b {c d} {e "long default value"}} {}
  217.     set value 12345
  218.     info d t1 a value
  219.     set value
  220. } {}
  221. test info-6.3 {info default option} {
  222.     proc t1 {a b {c d} {e "long default value"}} {}
  223.     info default t1 c value
  224. } 1
  225. test info-6.4 {info default option} {
  226.     proc t1 {a b {c d} {e "long default value"}} {}
  227.     set value 12345
  228.     info default t1 c value
  229.     set value
  230. } d
  231. test info-6.5 {info default option} {
  232.     proc t1 {a b {c d} {e "long default value"}} {}
  233.     set value 12345
  234.     set x [info default t1 e value]
  235.     list $x $value
  236. } {1 {long default value}}
  237. test info-6.6 {info default option} {
  238.     list [catch {info default a b} msg] $msg
  239. } {1 {wrong # args: should be "info default procname arg varname"}}
  240. test info-6.7 {info default option} {
  241.     list [catch {info default _nonexistent_ a b} msg] $msg
  242. } {1 {"_nonexistent_" isn't a procedure}}
  243. test info-6.8 {info default option} {
  244.     proc t1 {a b} {}
  245.     list [catch {info default t1 x value} msg] $msg
  246. } {1 {procedure "t1" doesn't have an argument "x"}}
  247. test info-6.9 {info default option} {
  248.     catch {unset a}
  249.     set a(0) 88
  250.     proc t1 {a b} {}
  251.     list [catch {info default t1 a a} msg] $msg
  252. } {1 {couldn't store default value in variable "a"}}
  253. test info-6.10 {info default option} {
  254.     catch {unset a}
  255.     set a(0) 88
  256.     proc t1 {{a 18} b} {}
  257.     list [catch {info default t1 a a} msg] $msg
  258. } {1 {couldn't store default value in variable "a"}}
  259. catch {unset a}
  260.  
  261. test info-7.1 {info exists option} {
  262.     set value foo
  263.     info exists value
  264. } 1
  265. catch {unset _nonexistent_}
  266. test info-7.2 {info exists option} {
  267.     info exists _nonexistent_
  268. } 0
  269. test info-7.3 {info exists option} {
  270.     proc t1 {x} {return [info exists x]}
  271.     t1 2
  272. } 1
  273. test info-7.4 {info exists option} {
  274.     proc t1 {x} {
  275.         global _nonexistent_
  276.         return [info exists _nonexistent_]
  277.     }
  278.     t1 2
  279. } 0
  280. test info-7.5 {info exists option} {
  281.     proc t1 {x} {
  282.         set y 47
  283.         return [info exists y]
  284.     }
  285.     t1 2
  286. } 1
  287. test info-7.6 {info exists option} {
  288.     proc t1 {x} {return [info exists value]}
  289.     t1 2
  290. } 0
  291. test info-7.7 {info exists option} {
  292.     catch {unset x}
  293.     set x(2) 44
  294.     list [info exists x] [info exists x(1)] [info exists x(2)]
  295. } {1 0 1}
  296. catch {unset x}
  297. test info-7.8 {info exists option} {
  298.     list [catch {info exists} msg] $msg
  299. } {1 {wrong # args: should be "info exists varName"}}
  300. test info-7.9 {info exists option} {
  301.     list [catch {info exists 1 2} msg] $msg
  302. } {1 {wrong # args: should be "info exists varName"}}
  303.  
  304. test info-8.1 {info globals option} {
  305.     set x 1
  306.     set y 2
  307.     set value 23
  308.     set a " [info globals] "
  309.     list [string match {* x *} $a] [string match {* y *} $a] \
  310.             [string match {* value *} $a] [string match {* _foobar_ *} $a]
  311. } {1 1 1 0}
  312. test info-8.2 {info globals option} {
  313.     set _xxx1 1
  314.     set _xxx2 2
  315.     lsort [info g _xxx*]
  316. } {_xxx1 _xxx2}
  317. test info-8.3 {info globals option} {
  318.     list [catch {info globals 1 2} msg] $msg
  319. } {1 {wrong # args: should be "info globals [pattern]"}}
  320.  
  321. test info-9.1 {info level option} {
  322.     info level
  323. } 0
  324. test info-9.2 {info level option} {
  325.     proc t1 {a b} {
  326.         set x [info le]
  327.         set y [info level 1]
  328.         list $x $y
  329.     }
  330.     t1 146 testString
  331. } {1 {t1 146 testString}}
  332. test info-9.3 {info level option} {
  333.     proc t1 {a b} {
  334.         t2 [expr $a*2] $b
  335.     }
  336.     proc t2 {x y} {
  337.         list [info level] [info level 1] [info level 2] [info level -1] \
  338.                 [info level 0]
  339.     }
  340.     t1 146 {a {b c} {{{c}}}}
  341. } {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}}}}}}
  342. test info-9.4 {info level option} {
  343.     proc t1 {} {
  344.         set x [info level]
  345.         set y [info level 1]
  346.         list $x $y
  347.     }
  348.     t1
  349. } {1 t1}
  350. test info-9.5 {info level option} {
  351.     list [catch {info level 1 2} msg] $msg
  352. } {1 {wrong # args: should be "info level [number]"}}
  353. test info-9.6 {info level option} {
  354.     list [catch {info level 123a} msg] $msg
  355. } {1 {expected integer but got "123a"}}
  356. test info-9.7 {info level option} {
  357.     list [catch {info level 0} msg] $msg
  358. } {1 {bad level "0"}}
  359. test info-9.8 {info level option} {
  360.     proc t1 {} {info level -1}
  361.     list [catch {t1} msg] $msg
  362. } {1 {bad level "-1"}}
  363. test info-9.9 {info level option} {
  364.     proc t1 {x} {info level $x}
  365.     list [catch {t1 -3} msg] $msg
  366. } {1 {bad level "-3"}}
  367.  
  368. set savedLibrary tcl_library
  369. test info-10.1 {info library option} {
  370.     list [catch {info library x} msg] $msg
  371. } {1 {wrong # args: should be "info library"}}
  372. test info-10.2 {info library option} {
  373.     set tcl_library 12345
  374.     info library
  375. } {12345}
  376. test info-10.3 {info library option} {
  377.     unset tcl_library
  378.     list [catch {info library} msg] $msg
  379. } {1 {no library has been specified for Tcl}}
  380. set tcl_library $savedLibrary
  381.  
  382. test info-11.1 {info locals option} {
  383.     set a 22
  384.     proc t1 {x y} {
  385.         set b 13
  386.         set c testing
  387.         global a
  388.         return [info locals]
  389.     }
  390.     lsort [t1 23 24]
  391. } {b c x y}
  392. test info-11.2 {info locals option} {
  393.     proc t1 {x y} {
  394.         set xx1 2
  395.         set xx2 3
  396.         set y 4
  397.         return [info lo x*]
  398.     }
  399.     lsort [t1 2 3]
  400. } {x xx1 xx2}
  401. test info-11.3 {info locals option} {
  402.     list [catch {info locals 1 2} msg] $msg
  403. } {1 {wrong # args: should be "info locals [pattern]"}}
  404. test info-11.4 {info locals option} {
  405.     info locals
  406. } {}
  407. test info-11.5 {info locals option} {
  408.     proc t1 {} {return [info locals]}
  409.     t1
  410. } {}
  411.  
  412. test info-12.1 {info patchlevel option} {
  413.     set a [info patchlevel]
  414.     regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
  415. } 1
  416. test info-12.2 {info patchlevel option} {
  417.     list [catch {info patchlevel a} msg] $msg
  418. } {1 {wrong # args: should be "info patchlevel"}}
  419. test info-12.3 {info patchlevel option} {
  420.     set t $tcl_patchLevel
  421.     unset tcl_patchLevel
  422.     set result [list [catch {info patchlevel} msg] $msg]
  423.     set tcl_patchLevel $t
  424.     set result
  425. } {1 {can't read "tcl_patchLevel": no such variable}}
  426.  
  427. test info-13.1 {info procs option} {
  428.     proc t1 {} {}
  429.     proc t2 {} {}
  430.     set x " [info procs] "
  431.     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
  432.             [string match {* _undefined_ *} $x]
  433. } {1 1 0}
  434. test info-13.2 {info procs option} {
  435.     proc _tt1 {} {}
  436.     proc _tt2 {} {}
  437.     lsort [info pr _tt*]
  438. } {_tt1 _tt2}
  439. catch {rename _tt1 {}}
  440. catch {rename _tt2 {}}
  441. test info-13.3 {info procs option} {
  442.     list [catch {info procs 2 3} msg] $msg
  443. } {1 {wrong # args: should be "info procs [pattern]"}}
  444.  
  445. test info-14.1 {info script option} {
  446.     list [catch {info script x} msg] $msg
  447. } {1 {wrong # args: should be "info script"}}
  448. test info-14.2 {info script option} {
  449.     file tail [info s]
  450. } info.test
  451. catch {exec rm -f gorp.info}
  452. exec cat > gorp.info << "info script\n"
  453. test info-14.3 {info script option} {
  454.     list [source gorp.info] [file tail [info script]]
  455. } {gorp.info info.test}
  456. test info-14.4 {resetting "info script" after errors} {
  457.     catch {source ~_nobody_/foo}
  458.     file tail [info script]
  459. } {info.test}
  460. test info-14.5 {resetting "info script" after errors} {
  461.     catch {source _nonexistent_}
  462.     file tail [info script]
  463. } {info.test}
  464. exec rm -f gorp.info
  465.  
  466. test info-15.1 {info tclversion option} {
  467.     set x [info tclversion]
  468.     scan $x "%d.%d%c" a b c
  469. } 2
  470. test info-15.2 {info tclversion option} {
  471.     list [catch {info t 2} msg] $msg
  472. } {1 {wrong # args: should be "info tclversion"}}
  473. test info-15.3 {info tclversion option} {
  474.     set t $tcl_version
  475.     unset tcl_version
  476.     set result [list [catch {info tclversion} msg] $msg]
  477.     set tcl_version $t
  478.     set result
  479. } {1 {can't read "tcl_version": no such variable}}
  480.  
  481. test info-16.1 {info vars option} {
  482.     set a 1
  483.     set b 2
  484.     proc t1 {x y} {
  485.         global a b
  486.         set c 33
  487.         return [info vars]
  488.     }
  489.     lsort [t1 18 19]
  490. } {a b c x y}
  491. test info-16.2 {info vars option} {
  492.     set xxx1 1
  493.     set xxx2 2
  494.     proc t1 {xxa y} {
  495.         global xxx1 xxx2
  496.         set c 33
  497.         return [info vars x*]
  498.     }
  499.     lsort [t1 18 19]
  500. } {xxa xxx1 xxx2}
  501. test info-16.3 {info vars option} {
  502.     lsort [info vars]
  503. } [lsort [info globals]]
  504. test info-16.4 {info vars option} {
  505.     list [catch {info vars a b} msg] $msg
  506. } {1 {wrong # args: should be "info vars [pattern]"}}
  507.  
  508. test info-17.1 {miscellaneous error conditions} {
  509.     list [catch {info} msg] $msg
  510. } {1 {wrong # args: should be "info option ?arg arg ...?"}}
  511. test info-17.2 {miscellaneous error conditions} {
  512.     list [catch {info gorp} msg] $msg
  513. } {1 {bad option "gorp": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, patchlevel, procs, script, tclversion, or vars}}
  514. test info-17.3 {miscellaneous error conditions} {
  515.     list [catch {info c} msg] $msg
  516. } {1 {bad option "c": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, patchlevel, procs, script, tclversion, or vars}}
  517. test info-17.4 {miscellaneous error conditions} {
  518.     list [catch {info l} msg] $msg
  519. } {1 {bad option "l": should be args, body, cmdcount, commands, complete, default, exists, globals, level, library, locals, patchlevel, procs, script, tclversion, or vars}}
  520.