1# 2# Tests for "auto_import" and autoloading facility 3# ---------------------------------------------------------------------- 4# AUTHOR: Michael J. McLennan 5# Bell Labs Innovations for Lucent Technologies 6# mmclennan@lucent.com 7# http://www.tcltk.com/itcl 8# 9# RCS: $Id: import.test,v 1.6 2004/04/29 05:57:42 davygrvy Exp $ 10# ---------------------------------------------------------------------- 11# Copyright (c) 1993-1998 Lucent Technologies, Inc. 12# ====================================================================== 13# See the file "license.terms" for information on usage and 14# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. 15 16if {[lsearch [namespace children] ::tcltest] == -1} { 17 package require tcltest 2.1 18 namespace import -force ::tcltest::test 19} 20 21::tcltest::loadTestedCommands 22 23# ---------------------------------------------------------------------- 24# Test "itcl::import::stub" command 25# ---------------------------------------------------------------------- 26test import-1.1 {basic syntax for "stub" command} { 27 list [catch {itcl::import::stub} result] $result 28} {1 {wrong # args: should be one of... 29 stub create name 30 stub exists name}} 31 32test import-1.2 {"stub create" requires one argument} { 33 list [catch {itcl::import::stub create} result] $result \ 34 [catch {itcl::import::stub create x y} result] $result 35} {1 {wrong # args: should be "itcl::import::stub create name"} 1 {wrong # args: should be "itcl::import::stub create name"}} 36 37test import-1.3 {"stub exists" requires one argument} { 38 list [catch {itcl::import::stub exists} result] $result \ 39 [catch {itcl::import::stub exists x y} result] $result 40} {1 {wrong # args: should be "itcl::import::stub exists name"} 1 {wrong # args: should be "itcl::import::stub exists name"}} 41 42set interp [interp create] 43$interp eval [subst -novariables { 44 [::tcltest::configure -load] 45 proc auto_load {cmd {namespace {}}} { 46 global debug 47 proc $cmd {args} \[format {return "%s: $args"} $cmd\] 48 append debug "(auto_load: $cmd)" 49 return 1 50 } 51}] 52 53test import-1.4 {"stub create" creates a stub that triggers autoloading} { 54 $interp eval { 55 set debug "" 56 list [itcl::import::stub create foo::bar::test] \ 57 [info commands ::foo::bar::test] \ 58 [::foo::bar::test 1 2 3] \ 59 $debug 60 } 61} {{} ::foo::bar::test {::foo::bar::test: 1 2 3} {(auto_load: ::foo::bar::test)}} 62 63test import-1.5 {"stub exists" recognizes stubs created by "stub create"} { 64 $interp eval { 65 set debug "" 66 itcl::import::stub create foo::bar::stub1 67 proc foo::bar::proc1 {{args {}}} {return "proc1: $args"} 68 list [itcl::import::stub exists foo::bar::stub1] \ 69 [itcl::import::stub exists foo::bar::proc1] 70 } 71} {1 0} 72 73test import-1.6 {stubs can be autoloaded and replaced} { 74 $interp eval { 75 set debug "" 76 itcl::import::stub create foo::bar::stub2 77 list [itcl::import::stub exists foo::bar::stub2] \ 78 [::foo::bar::stub2 a b c] \ 79 [itcl::import::stub exists foo::bar::stub2] \ 80 [::foo::bar::stub2 a b c] \ 81 $debug 82 } 83} {1 {::foo::bar::stub2: a b c} 0 {::foo::bar::stub2: a b c} {(auto_load: ::foo::bar::stub2)}} 84 85catch {interp delete $interp} 86 87# ---------------------------------------------------------------------- 88# Test "itcl::import::stub" command 89# ---------------------------------------------------------------------- 90set interp [interp create] 91$interp eval [subst -novariables { 92 [::tcltest::configure -load] 93 proc auto_load {cmd {namespace {}}} { 94 proc $cmd {args} \[format {return "%s: $args"} $cmd\] 95 return 1 96 } 97}] 98 99test import-2.1 {initialize some commands for autoloading} { 100 $interp eval { 101 namespace eval test { 102 namespace export foo* 103 } 104 itcl::import::stub create ::test::foo1 105 itcl::import::stub create ::test::foo2 106 lsort [info commands ::test::*] 107 } 108} {::test::foo1 ::test::foo2} 109 110test import-2.2 {stubs can be imported into other namespaces} { 111 $interp eval { 112 namespace eval user1 { namespace import ::test::* } 113 namespace eval user2 { namespace import ::test::* } 114 namespace eval user3 { namespace import ::test::* } 115 list [lsort [info commands ::user1::*]] \ 116 [namespace origin ::user1::foo1] \ 117 [namespace origin ::user1::foo2] 118 } 119} {{::user1::foo1 ::user1::foo2} ::test::foo1 ::test::foo2} 120 121test import-2.3 {stubs can be autoloaded and imported links remain} { 122 $interp eval { 123 list [::user1::foo1 1 2 3 4] \ 124 [namespace origin ::user1::foo1] \ 125 [namespace origin ::user2::foo1] \ 126 [namespace origin ::user3::foo1] \ 127 [itcl::import::stub exists ::test::foo1] 128 } 129} {{::test::foo1: 1 2 3 4} ::test::foo1 ::test::foo1 ::test::foo1 0} 130 131test import-2.3 {itcl::class handles stubs correctly} { 132 $interp eval { 133 proc auto_load {cmd {namespace {}}} { 134 itcl::class $cmd { } 135 return 1 136 } 137 list [::user2::foo2 x] \ 138 [x info class] \ 139 [namespace origin ::user1::foo2] \ 140 [namespace origin ::user2::foo2] \ 141 [namespace origin ::user3::foo2] \ 142 [itcl::import::stub exists ::test::foo2] 143 } 144} {x ::test::foo2 ::test::foo2 ::test::foo2 ::test::foo2 0} 145 146test import-2.3 {itcl::class will overwrite stubs in an existing namespace} { 147 $interp eval { 148 namespace eval test::buried { } 149 itcl::import::stub create ::test::buried 150 itcl::import::stub create ::test::buried::stub 151 list [catch {::test::buried xx} result] $result [xx info class] 152 } 153} {0 xx ::test::buried} 154 155catch {interp delete $interp} 156 157::tcltest::cleanupTests 158return 159