OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [load.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# Commands covered:  load
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) 1995 Sun Microsystems, Inc.
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: load.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
13 
 
14 
if {[string compare test [info procs test]] == 1} then {source defs}
15 
 
16 
# Figure out what extension is used for shared libraries on this
17 
# platform.
18 
 
19 
if {$tcl_platform(platform) == "macintosh"} {
20 
    puts "can't run dynamic library tests on macintosh machines"
21 
    return
22 
}
23 
set ext [info sharedlibextension]
24 
set testDir [file join [file dirname [info nameofexecutable]] dltest]
25 
if ![file readable [file join $testDir pkga$ext]] {
26 
    puts "libraries in $testDir haven't been compiled: skipping tests"
27 
    return
28 
}
29 
 
30 
if [string match *pkga* [set alreadyLoaded [info loaded]]] {
31 
    puts "load tests have already been run once:  skipping (can't rerun)"
32 
    return
33 
}
34 
 
35 
set alreadyTotalLoaded [info loaded]
36 
 
37 
test load-1.1 {basic errors} {
38 
    list [catch {load} msg] $msg
39 
} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
40 
test load-1.2 {basic errors} {
41 
    list [catch {load a b c d} msg] $msg
42 
} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
43 
test load-1.3 {basic errors} {
44 
    list [catch {load a b foobar} msg] $msg
45 
} {1 {couldn't find slave interpreter named "foobar"}}
46 
test load-1.4 {basic errors} {
47 
    list [catch {load {}} msg] $msg
48 
} {1 {must specify either file name or package name}}
49 
test load-1.5 {basic errors} {
50 
    list [catch {load {} {}} msg] $msg
51 
} {1 {must specify either file name or package name}}
52 
test load-1.6 {basic errors} {
53 
    list [catch {load {} Unknown} msg] $msg
54 
} {1 {package "Unknown" isn't loaded statically}}
55 
 
56 
test load-2.1 {basic loading, with guess for package name} {
57 
    load [file join $testDir pkga$ext]
58 
    list [pkga_eq abc def] [info commands pkga_*]
59 
} {0 {pkga_eq pkga_quote}}
60 
interp create -safe child
61 
test load-2.2 {loading into a safe interpreter, with package name conversion} {
62 
    load [file join $testDir pkgb$ext] pKgB child
63 
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
64 
            [catch {pkgb_sub 12 10} msg2] $msg2
65 
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
66 
test load-2.3 {loading with no _Init procedure} {
67 
    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg
68 
} {1 {couldn't find procedure Foo_Init}}
69 
test load-2.4 {loading with no _SafeInit procedure} {
70 
    list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
71 
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}
72 
 
73 
test load-3.1 {error in _Init procedure, same interpreter} {
74 
    list [catch {load [file join $testDir pkge$ext] pkge} msg] $msg $errorInfo $errorCode
75 
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
76 
    while executing
77 
"open non_existent"
78 
    invoked from within
79 
"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
80 
test load-3.2 {error in _Init procedure, slave interpreter} {
81 
    catch {interp delete x}
82 
    interp create x
83 
    set errorCode foo
84 
    set errorInfo bar
85 
    set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
86 
            $msg $errorInfo $errorCode]
87 
    interp delete x
88 
    set result
89 
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
90 
    while executing
91 
"open non_existent"
92 
    invoked from within
93 
"load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}
94 
 
95 
test load-4.1 {reloading package into same interpreter} {
96 
    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
97 
} {0 {}}
98 
test load-4.2 {reloading package into same interpreter} {
99 
    list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
100 
} "1 {file \"[file join $testDir pkga$ext\"] is already loaded for package \"Pkga\"}"
101 
 
102 
test load-5.1 {file name not specified and no static package: pick default} {
103 
    catch {interp delete x}
104 
    interp create x
105 
    load [file join $testDir pkga$ext] pkga
106 
    load {} pkga x
107 
    set result [info loaded x]
108 
    interp delete x
109 
    set result
110 
} "{[file join $testDir pkga$ext] Pkga}"
111 
 
112 
# On some platforms, like SunOS 4.1.3, these tests can't be run because
113 
# they cause the process to exit.
114 
 
115 
test load-6.1 {errors loading file} {nonPortable} {
116 
    catch {load foo foo}
117 
} {1}
118 
 
119 
if {[info command teststaticpkg] != ""} {
120 
    test load-7.1 {Tcl_StaticPackage procedure} {
121 
        set x "not loaded"
122 
        teststaticpkg Test 1 0
123 
        load {} Test
124 
        load {} Test child
125 
        list [set x] [child eval set x]
126 
    } {loaded loaded}
127 
    test load-7.2 {Tcl_StaticPackage procedure} {
128 
        set x "not loaded"
129 
        teststaticpkg Another 0 0
130 
        load {} Another
131 
        child eval {set x "not loaded"}
132 
        list [catch {load {} Another child} msg] $msg [child eval set x] [set x]
133 
    } {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
134 
    test load-7.3 {Tcl_StaticPackage procedure} {
135 
        set x "not loaded"
136 
        teststaticpkg More 0 1
137 
        load {} More
138 
        set x
139 
    } {not loaded}
140 
    test load-7.4 {Tcl_StaticPackage procedure, redundant calls} {
141 
        teststaticpkg Double 0 1
142 
        teststaticpkg Double 0 1
143 
        info loaded
144 
    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
145 
 
146 
    test load-8.1 {TclGetLoadedPackages procedure} {
147 
        info loaded
148 
    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
149 
    test load-8.2 {TclGetLoadedPackages procedure} {
150 
        list [catch {info loaded gorp} msg] $msg
151 
    } {1 {couldn't find slave interpreter named "gorp"}}
152 
    test load-8.3 {TclGetLoadedPackages procedure} {
153 
        list [info loaded {}] [info loaded child]
154 
    } "{{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}"
155 
    test load-8.4 {TclGetLoadedPackages procedure} {
156 
        load [file join $testDir pkgb$ext] pkgb
157 
        list [info loaded {}] [lsort [info commands pkgb_*]]
158 
    } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}"
159 
    interp delete child
160 
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.