home *** CD-ROM | disk | FTP | other *** search
/ Serving the Web / ServingTheWeb1995.disc1of1.iso / linux / slacksrce / tcl / tcl+tk+t / tclx7.3bl / tclx7 / tclX7.3b / tests / tcllib.test < prev    next >
Encoding:
Text File  |  1994-07-16  |  9.5 KB  |  347 lines
  1. #
  2. # tcllib.test
  3. #
  4. # Tests for commands and functionallity involved in demand loadable Tcl
  5. # libraries.
  6. #---------------------------------------------------------------------------
  7. # Copyright 1992-1994 Karl Lehenbauer and Mark Diekhans.
  8. #
  9. # Permission to use, copy, modify, and distribute this software and its
  10. # documentation for any purpose and without fee is hereby granted, provided
  11. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  12. # Mark Diekhans make no representations about the suitability of this
  13. # software for any purpose.  It is provided "as is" without express or
  14. # implied warranty.
  15. #------------------------------------------------------------------------------
  16. # $Id: tcllib.test,v 4.0 1994/07/16 05:25:16 markd Rel $
  17. #------------------------------------------------------------------------------
  18. #
  19.  
  20. if {[info procs test] == ""} then {source testlib.tcl}
  21. eval $SAVED_UNKNOWN
  22.  
  23. # Load the slow-path part of the unknown command.  Otherwise the unknown
  24. # command will not work when the loadpath is changed.
  25.  
  26. if ![auto_load tclx_unknown2] {
  27.     error "can't auto_load tclx_unknown2"
  28. }
  29.  
  30. global save_auto_path auto_path
  31. set save_auto_path $auto_path
  32. set auto_path {}
  33. catch {unset auto_path}
  34.  
  35. if {[id user] == "root"} {
  36.     puts "*************************************************************"
  37.     puts "You are running as `root', certain tcllib tests will be"
  38.     puts "skipped"
  39.     puts "*************************************************************"
  40. }
  41.  
  42. #
  43. # Since we have libraries coming and going in this test, we need to
  44. # reset the environment.  
  45. #
  46. proc TclLibReset {} {
  47.     global auto_execs auto_index auto_pkg_index auto_path
  48.     catch {unset auto_execs}
  49.     catch {unset auto_index}
  50.     catch {unset auto_pkg_index}
  51.     
  52.     # This alters the internal knowledge of the last path that was loaded.
  53.     if [info exists auto_path] {
  54.         set save_auto_path $auto_path
  55.     } else {
  56.         set save_auto_path {}
  57.     }
  58.     set auto_path {}
  59.     auto_load
  60.     set auto_path $save_auto_path
  61. }
  62.  
  63. proc TclLibCleanUp {} {
  64.     catch {chmod u=wrx {tcllib1.dir tcllib2.dir}}
  65.     exec rm -rf tcllib1.dir tcllib2.dir
  66.     TclLibReset
  67. }
  68.  
  69. TclLibCleanUp
  70.  
  71. proc PutFile {fileName args} {
  72.     set fp [open $fileName w]
  73.     foreach line $args {
  74.         puts $fp $line
  75.     }
  76.     close $fp
  77. }
  78.  
  79. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  80.  
  81. #
  82. # Test parameter checking for the basic commands that are implemented
  83. # in C.
  84. #
  85.  
  86. Test tcllib-1.1 {command parameter checking} {
  87.     auto_load a b c d
  88. } 1 {wrong # args: auto_load ?command?}
  89.  
  90. Test tcllib-1.2 {command parameter checking} {
  91.     loadlibindex
  92. } 1 {wrong # args: loadlibindex libFile}
  93.  
  94. Test tcllib-1.3 {command parameter checking} {
  95.     loadlibindex a b c d
  96. } 1 {wrong # args: loadlibindex libFile}
  97.  
  98. #
  99. # Test error recovery from bogus paths (should ignore path and not find proc)
  100. #
  101.  
  102. Test tcllib-2.1 {bogus path test} {
  103.     set auto_path [list /bogus/dir/path/no/work [pwd]/../tclmaster]
  104.     TclLibAAA
  105. } 1 {invalid command name "TclLibAAA"}
  106.  
  107. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  108.  
  109. Test tcllib-2.2 {bogus path test} {
  110.     set auto_path [list ~bogususerman/tcllib [pwd]/../tclmaster]
  111.     TclLibAAA
  112. } 1 {invalid command name "TclLibAAA"}
  113.  
  114. Test tcllib-2.3 {bogus path test} {
  115.     set auto_path [pwd]/../tclmaster
  116.     set auto_path [list /bogus/dir/path/no/work]
  117.     TclLibAAA
  118. } 1 {invalid command name "TclLibAAA"}
  119.  
  120.  
  121. #
  122. # Test error recovery from bogus package library indices.
  123. #
  124.  
  125. proc BuildTestLib {name {pbase TclLibAA}} {
  126.    PutFile $name \
  127.         "#@package: $name-package ${pbase}B ${pbase}C ${pbase}D" \
  128.         "proc ${pbase}B {} {return \"***${pbase}B***\"}" \
  129.         "proc ${pbase}C {} {return \"***${pbase}C***\"}" \
  130.         "proc ${pbase}D {} {return \"***${pbase}D***\"}" \
  131.         "#@packend"
  132. }
  133.  
  134. mkdir tcllib1.dir
  135. BuildTestLib tcllib1.dir/test1.tlib
  136. PutFile tcllib1.dir/test1.tndx {bogus
  137. data}
  138.  
  139. TclLibReset
  140. set auto_path [list [pwd]/tcllib1.dir [pwd]/../tclmaster]
  141.  
  142. TestReg tcllib-3.1 {bogus package library index} {
  143.     TclLibAAB
  144. } 1 {^format error in library index "/.*test1.tndx" \(bogus\)$}
  145.  
  146. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  147.  
  148. PutFile tcllib1.dir/test1.tndx \
  149.     {test1-package 56 240 TclLibAAB TclLibAAC TclLibAAD}
  150.  
  151. TestReg tcllib-3.2 {bogus package library index} {
  152.     TclLibAAB
  153. } 1 {^range to eval outside of file bounds "/.*test1.tlib"$}
  154.  
  155.  
  156. PutFile tcllib1.dir/test1.tndx \
  157.     {test1-package -1 140 TclLibAAB TclLibAAC TclLibAAD}
  158.  
  159. TestReg tcllib-3.3 {bogus package library index} {
  160.     TclLibAAB
  161. } 1 {^range to eval outside of file bounds "/.*test1.tlib"$}
  162.  
  163. catch {rename buildpackageindex {}} ;# Make sure we can autoload this
  164.  
  165. PutFile tcllib1.dir/test1.tndx \
  166.     {test1-package 156 40 TclLibAAB TclLibAAC TclLibAAD}
  167.  
  168. TestReg tcllib-3.4 {bogus package library index} {
  169.     TclLibAAB
  170. } 1 {^range to eval outside of file bounds "/}
  171.  
  172. TclLibReset
  173. set auto_path [list [pwd]/tcllib2.dir [pwd]/../tclmaster]
  174.  
  175. if {[id user] != "root"} {
  176.     Test tcllib-4.1 {bad rebuild package library index} {
  177.         global errorCode errorInfo
  178.         mkdir tcllib2.dir
  179.         BuildTestLib tcllib2.dir/test1.tlib TclLibAB
  180.         chmod -w tcllib2.dir
  181.         list [catch {TclLibABB} msg] [crange $msg 0 25] \
  182.              [lrange $errorCode 0 1] \
  183.              [string match "*while loading Tcl library index*" $errorInfo] \
  184.              [string match "*while auto loading \"TclLibABB\"*" $errorInfo]
  185.     } 0 {1 {building package index for} {POSIX EACCES} 1 1}
  186. }
  187.  
  188. TclLibCleanUp
  189. mkdir tcllib1.dir
  190. set auto_path [list [pwd]/tcllib1.dir [pwd]/../tclmaster]
  191.  
  192. PutFile tcllib1.dir/tclIndex "#" "badline" "nukearray nukearray.tmp" \
  193.     "baz baz.tmp"
  194.  
  195. Test tcllib-5.1 {bogus Ousterhout library index} {
  196.     set stat [catch nukearray msg]
  197.     if [string match "*/tclIndex isn't a proper Tcl index file" $msg] {
  198.         list $stat {IS OK}
  199.     } else {
  200.         list $stat $msg
  201.     }
  202. } 0 {1 {IS OK}}
  203.  
  204. PutFile tcllib1.dir/tclIndex "# Tcl autoload index file, version 2.0" \
  205.         {set auto_index(parray)   " source $dir/parray.tcl"} \
  206.         {set auto_index(nukearray) "source $dir/spazzzzzzzz"} \
  207.  
  208. TestReg tcllib-5.2 {missing file found with Ousterhout library index} {
  209.     nukearray
  210. } 1 {^couldn't read file}
  211.  
  212. PutFile tcllib1.dir/nukearray.tmp {proc nukearray {} {}}
  213. chmod 000 tcllib1.dir/nukearray.tmp
  214.  
  215. if {[id user] != "root"} {
  216.     TestReg tcllib-5.3 {missing file found with Ousterhout library index} {
  217.         nukearray
  218.     } 1 {^couldn't read file}
  219. }
  220.  
  221. TclLibCleanUp
  222. mkdir tcllib1.dir
  223.  
  224. BuildTestLib  tcllib1.dir/test2.tlib TclLibAC
  225. set auto_path [list [pwd]/tcllib1.dir [pwd]/../tclmaster]
  226.  
  227. PutFile tcllib1.dir/tclIndex "# Tcl autoload index file, version 2.0" \
  228.         {set auto_index(parray)   " source $dir/parray.tcl"} \
  229.         {set auto_index(nukearray) "source $dir/nukearray.tmp"}
  230. PutFile tcllib1.dir/nukearray.tmp {proc nukearray {} {return "@nukearray@"}}
  231.  
  232. Test tcllib-6.1 {successful library access} {
  233.     TclLibACB
  234. } 0 {***TclLibACB***}
  235.  
  236. Test tcllib-6.2 {successful library access} {
  237.     TclLibACB
  238. } 0 {***TclLibACB***}
  239.  
  240. Test tcllib-6.3 {successful library access} {
  241.     nukearray
  242. } 0 {@nukearray@}
  243.  
  244. #
  245. # Test skipping of duplicate packages.  Also make sure loadlibindex overrides
  246. # existing package definitions.  Test for both .tlib and tclIndex indexes.
  247. #
  248. TclLibCleanUp
  249. mkdir {tcllib1.dir tcllib2.dir}
  250. set auto_path [list [pwd]/tcllib1.dir [pwd]/tcllib2.dir [pwd]/../tclmaster]
  251.  
  252. PutFile tcllib1.dir/test1.tlib \
  253.     {#@package: test-pkg DupPkgTest} \
  254.     {proc DupPkgTest {} {return {Version-1}}
  255. }
  256. PutFile tcllib2.dir/test2.tlib \
  257.     {#@package: test-pkg DupPkgTest} \
  258.     {proc DupPkgTest {} {return {Version-2}}
  259. }
  260.  
  261. Test tcllib-7.1 {Duplicate package handling} {
  262.     DupPkgTest
  263. } 0 {Version-1}
  264.  
  265. TclLibReset
  266. rename DupPkgTest {}
  267.  
  268. Test tcllib-7.2 {Duplicate package handling} {
  269.     lrmdups {a b c}  ;# Force load of indices.
  270.     loadlibindex tcllib2.dir/test2.tlib
  271.     DupPkgTest
  272. } 0 {Version-2}
  273.  
  274. TclLibCleanUp
  275. rename DupPkgTest {}
  276. mkdir {tcllib1.dir tcllib2.dir}
  277. set auto_path [list [pwd]/tcllib1.dir [pwd]/tcllib2.dir [pwd]/../tclmaster]
  278.  
  279. PutFile tcllib1.dir/tclIndex "# Tcl autoload index file, version 2.0" \
  280.         {set auto_index(DupPkgTest)  " source $dir/test1.tcl"}
  281.  
  282. PutFile tcllib1.dir/test1.tcl \
  283.     {proc DupPkgTest {} {return {Version-1}}
  284. }
  285.  
  286. PutFile tcllib2.dir/tclIndex "# Tcl autoload index file, version 2.0" \
  287.         {set auto_index(DupPkgTest)  " source $dir/test1.tcl"}
  288.  
  289. PutFile tcllib2.dir/test1.tcl \
  290.     {proc DupPkgTest {} {return {Version-2}}
  291. }
  292.  
  293. Test tcllib-7.3 {Duplicate package handling} {
  294.     DupPkgTest
  295. } 0 {Version-1}
  296.  
  297. TclLibReset
  298. rename DupPkgTest {}
  299.  
  300. Test tcllib-7.4 {Duplicate package handling} {
  301.     lrmdups {a b c}  ;# Force load of indices.
  302.     loadlibindex tcllib2.dir/tclIndex
  303.     DupPkgTest
  304. } 0 {Version-2}
  305.  
  306.  
  307. #
  308. # Test backslash parsing in #@package: line.
  309. #
  310. TclLibCleanUp
  311. mkdir {tcllib1.dir tcllib2.dir}
  312. set auto_path [list [pwd]/tcllib1.dir [pwd]/tcllib2.dir [pwd]/../tclmaster]
  313.  
  314. PutFile tcllib1.dir/test1.tlib \
  315.     {#@package: test-pkg procAAA \\} \
  316.     {           procBBB \\         } \
  317.     {           procCCC            } \
  318.     {proc procAAA {} {return {AAA}}} \
  319.     {proc procBBB {} {return {BBB}}} \
  320.     {proc procCCC {} {return {CCC}}}
  321.  
  322. Test tcllib-8.1 {backslash parsing in package headers} {
  323.     TclLibReset
  324.     procAAA
  325. } 0 {AAA}
  326.  
  327.  
  328. Test tcllib-8.2 {backslash parsing in package headers} {
  329.     TclLibReset
  330.     procBBB
  331. } 0 {BBB}
  332.  
  333.  
  334. Test tcllib-8.3 {backslash parsing in package headers} {
  335.     TclLibReset
  336.     procCCC
  337. } 0 {CCC}
  338.  
  339. TclLibCleanUp
  340.  
  341. rename TclLibCleanUp {}
  342. rename PutFile {}
  343. rename TclLibReset {}
  344.  
  345. set auto_path $save_auto_path
  346. rename unknown {}
  347.