tcl/tests/autoMkindex.test

   1 # Commands covered:  auto_mkindex auto_import
   2 #
   3 # This file contains tests related to autoloading and generating
   4 # the autoloading index.
   5 #
   6 # Copyright (c) 1998  Lucent Technologies, Inc.
   7 # Copyright (c) 1998-1999 by Scriptics Corporation.
   8 #
   9 # See the file "license.terms" for information on usage and redistribution
  10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11 #
  12 # RCS: @(#) $Id$
  13
  14 if {[lsearch [namespace children] ::tcltest] == -1} {
  15     package require tcltest
  16     namespace import -force ::tcltest::*
  17 }
  18
  19 # temporarily copy the autoMkindex.tcl file from testsDirectory to
  20 # temporaryDirectory
  21 set origMkindexFile [file join $::tcltest::testsDirectory autoMkindex.tcl]
  22 set newMkindexFile [file join $::tcltest::temporaryDirectory autoMkindex.tcl]
  23 if {![catch {file copy $origMkindexFile $newMkindexFile}]} {
  24     set removeAutoMkindex 1
  25 }
  26
  27 # Save initial state of auto_mkindex_parser
  28
  29 auto_load auto_mkindex
  30 if {[info exist auto_mkindex_parser::initCommands]} {
  31     set saveCommands $auto_mkindex_parser::initCommands
  32 }
  33 proc AutoMkindexTestReset {} {
  34     global saveCommands
  35     if {[info exist saveCommands]} {
  36         set auto_mkindex_parser::initCommands $saveCommands
  37     } elseif {[info exist auto_mkindex_parser::initCommands]} {
  38         unset auto_mkindex_parser::initCommands
  39     }
  40 }
  41
  42 set result ""
  43
  44 set origDir [pwd]
  45 cd $::tcltest::testsDirectory
  46
  47 test autoMkindex-1.1 {remove any existing tclIndex file} {
  48     file delete tclIndex
  49     file exists tclIndex
  50 } {0}
  51
  52 test autoMkindex-1.2 {build tclIndex based on a test file} {
  53     auto_mkindex . autoMkindex.tcl
  54     file exists tclIndex
  55 } {1}
  56
  57 set element "{source [file join . autoMkindex.tcl]}"
  58
  59 test autoMkindex-1.3 {examine tclIndex} {
  60     file delete tclIndex
  61     auto_mkindex . autoMkindex.tcl
  62     namespace eval tcl_autoMkindex_tmp {
  63         set dir "."
  64         variable auto_index
  65         source tclIndex
  66         set ::result ""
  67         foreach elem [lsort [array names auto_index]] {
  68             lappend ::result [list $elem $auto_index($elem)]
  69         }
  70     }
  71     namespace delete tcl_autoMkindex_tmp
  72     set ::result
  73 } "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {normal $element} {top $element}"
  74
  75
  76 test autoMkindex-2.1 {commands on the autoload path can be imported} {
  77     file delete tclIndex
  78     auto_mkindex . autoMkindex.tcl
  79     set interp [interp create]
  80     set final [$interp eval {
  81         namespace eval blt {}
  82         set auto_path [linsert $auto_path 0 .]
  83         set info [list [catch {namespace import buried::*} result] $result]
  84         foreach name [lsort [info commands pub_*]] {
  85             lappend info $name [namespace origin $name]
  86         }
  87         set info
  88     }]
  89     interp delete $interp
  90     set final
  91 } "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"
  92
  93 # Test auto_mkindex hooks
  94
  95 # Slave hook executes interesting code in the interp used to watch code.
  96
  97 test autoMkindex-3.1 {slaveHook} {
  98     auto_mkindex_parser::slavehook {
  99         _%@namespace eval ::blt {
 100             proc foo {} {}
 101             _%@namespace export foo
 102         }
 103     }
 104     auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
 105     file delete tclIndex
 106     auto_mkindex . autoMkindex.tcl
 107
 108     # Reset initCommands to avoid trashing other tests
 109
 110     AutoMkindexTestReset
 111     file exists tclIndex
 112 } 1
 113
 114 # The auto_mkindex_parser::command is used to register commands
 115 # that create new commands.
 116
 117 test autoMkindex-3.2 {auto_mkindex_parser::command} {
 118     auto_mkindex_parser::command buried::myproc {name args} {
 119         variable index
 120         variable scriptFile
 121         append index [list set auto_index([fullname $name])] \
 122                 " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
 123     }
 124     file delete tclIndex
 125     auto_mkindex . autoMkindex.tcl
 126     namespace eval tcl_autoMkindex_tmp {
 127         set dir "."
 128         variable auto_index
 129         source tclIndex
 130         set ::result ""
 131         foreach elem [lsort [array names auto_index]] {
 132             lappend ::result [list $elem $auto_index($elem)]
 133         }
 134     }
 135     namespace delete tcl_autoMkindex_tmp
 136
 137     # Reset initCommands to avoid trashing other tests
 138
 139     AutoMkindexTestReset
 140     set ::result
 141 } "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
 142
 143
 144 test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
 145     auto_mkindex_parser::command {buried::my proc} {name args} {
 146         variable index
 147         variable scriptFile
 148         puts "my proc $name"
 149         append index [list set auto_index([fullname $name])] \
 150                 " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
 151     }
 152     file delete tclIndex
 153     auto_mkindex . autoMkindex.tcl
 154     namespace eval tcl_autoMkindex_tmp {
 155         set dir "."
 156         variable auto_index
 157         source tclIndex
 158         set ::result ""
 159         foreach elem [lsort [array names auto_index]] {
 160             lappend ::result [list $elem $auto_index($elem)]
 161         }
 162     }
 163     namespace delete tcl_autoMkindex_tmp
 164
 165     # Reset initCommands to avoid trashing other tests
 166
 167     AutoMkindexTestReset
 168     proc lvalue {list pattern} {
 169         set ix [lsearch $list $pattern]
 170         if {$ix >= 0} {
 171             return [lindex $list $ix]
 172         } else {
 173             return {}
 174         }
 175     }
 176     list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*]
 177 } "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
 178
 179 test autoMkindex-4.1 {platform indenpendant source commands} {
 180     file delete tclIndex
 181     auto_mkindex . pkg/samename.tcl
 182     set f [open tclIndex r]
 183     set dat [split [string trim [read $f]] "\n"]
 184     set len [llength $dat]
 185     set result [lsort [lrange $dat [expr {$len-2}] [expr {$len-1}]]]
 186     close $f
 187     set result
 188 } {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}
 189
 190 test autoMkindex-5.1 {escape magic tcl chars in general code} {
 191     file delete tclIndex
 192     set result {}
 193     if { ![catch {auto_mkindex . pkg/magicchar.tcl}] } {
 194         set f [open tclIndex r]
 195         set dat [split [string trim [read $f]] "\n"]
 196         set result [lindex $dat end]
 197         close $f
 198     }
 199     set result
 200 } {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}
 201 test autoMkindex-5.2 {correctly locate auto loaded procs with []} {
 202     file delete tclIndex
 203     set res {}
 204     if { ![catch {auto_mkindex . pkg/magicchar2.tcl}] } {
 205         # Make a slave interp to test the autoloading
 206         set c [interp create]
 207         $c eval {lappend auto_path [pwd]}
 208         set res [$c eval {catch {{[magic mojo proc]}}}]
 209         interp delete $c
 210     }
 211     set res
 212 } 0
 213
 214 # Clean up.
 215
 216 unset result
 217 AutoMkindexTestReset
 218 if {[info exist saveCommands]} {
 219     unset saveCommands
 220 }
 221 rename AutoMkindexTestReset ""
 222
 223 if {[info exists removeAutoMkindex]} {
 224     catch {file delete $newMkindexFile}
 225 }
 226 if {[file exists tclIndex]} {
 227     file delete -force tclIndex
 228 }
 229
 230 cd $origDir
 231
 232 ::tcltest::cleanupTests
 233