Tcl Source Code

Check-in [5c981db38c]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:defs: lint io.test: fix for bug 1580--"after 100" calls in test scripts were not waiting long enough for slower machines to complete i/o, so tests were fialing. load.test: some tests were getting skipping without the use of constraints.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 5c981db38c2c76267db59d6c8414429ff399e2be
User & Date: hershey 1999-03-25 17:20:00.000
Context
1999-03-25
19:43
* doc/Thread.3: Updated documentation of Tcl_MutexLock to indicate that the recursive locking behavi... check-in: e1a0b7d0c8 user: stanton tags: core-8-1-branch-old
17:20
defs: lint io.test: fix for bug 1580--"after 100" calls in test scripts were not waiting long ... check-in: 5c981db38c user: hershey tags: core-8-1-branch-old
04:32
Fixed bugs 1521, 1578, 1608--tests were failing due to bad test construction and failure to use cons... check-in: b21b173086 user: hershey tags: core-8-1-branch-old
Changes
Unified Diff Ignore Whitespace Patch
Changes to tests/defs.tcl. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

# defs.tcl --
#
#	This file contains support code for the Tcl/Tk test suite.It is
#	It is normally sourced by the individual files in the test suite
#	before they run their tests.  This improved approach to testing
#	was designed and initially implemented by Mary Ann May-Pumphrey
#	of Sun Microsystems.
#
# Copyright (c) 1990-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: defs.tcl,v 1.1.2.6 1999/03/24 23:53:44 hershey Exp $

# Initialize wish shell
if {[info exists tk_version]} {
    tk appname tktest
    wm title . tktest
} else {
    # Ensure that we have a minimal auto_path so we don't pick up extra junk.














|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

# defs.tcl --
#
#	This file contains support code for the Tcl/Tk test suite.It is
#	It is normally sourced by the individual files in the test suite
#	before they run their tests.  This improved approach to testing
#	was designed and initially implemented by Mary Ann May-Pumphrey
#	of Sun Microsystems.
#
# Copyright (c) 1990-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
# 
# RCS: @(#) $Id: defs.tcl,v 1.1.2.7 1999/03/25 17:20:00 hershey Exp $

# Initialize wish shell
if {[info exists tk_version]} {
    tk appname tktest
    wm title . tktest
} else {
    # Ensure that we have a minimal auto_path so we don't pick up extra junk.
︙︙
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423

    # ::tcltest::makeDirectory procedures.
    # Record the names of files in ::tcltest::workingDir that were not
    # pre-existing, and associate them with the test file that created them.
    if {!$calledFromAllFile} {

	foreach file $::tcltest::filesMade {
	    if {[file exists $file]} {
		#catch {file delete -force $file}
	    }
	}
	set currentFiles {}
	foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
	    lappend currentFiles [file tail $file]
	}
	set newFiles {}








|








409
410
411
412
413
414
415
416
417
418
419
420
421
422
423

    # ::tcltest::makeDirectory procedures.
    # Record the names of files in ::tcltest::workingDir that were not
    # pre-existing, and associate them with the test file that created them.
    if {!$calledFromAllFile} {

	foreach file $::tcltest::filesMade {
	    if {[file exists $file]} {
		catch {file delete -force $file}
	    }
	}
	set currentFiles {}
	foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
	    lappend currentFiles [file tail $file]
	}
	set newFiles {}
︙︙
Changes to tests/io.test.
︙︙
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: io.test,v 1.1.2.11 1999/03/25 04:32:17 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {"[info commands testchannel]" != "testchannel"} {
    puts "Skipping io tests. This application does not seem to have the"








|








8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: io.test,v 1.1.2.12 1999/03/25 17:20:00 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {"[info commands testchannel]" != "testchannel"} {
    puts "Skipping io tests. This application does not seem to have the"
︙︙
1478
1479
1480
1481
1482
1483
1484

1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507

    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\nfgh"
test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio} {
    # (chanPtr->flags & INPUT_SAW_CR)


    set f [open "|[list $tcltest cat]" w+]
    fconfigure $f -blocking 0 -buffering none -translation {auto lf}

    fileevent $f read "ready $f"
    proc ready {f} {
	lappend ::x [read $f] [testchannel queuedcr $f]
    }
    set x {}

    puts -nonewline $f "abcdefghj\r"
    after 100 {set y ok}
    vwait y

    puts -nonewline $f "\n01234"
    after 100 {set y ok}
    vwait y

    close $f
    set x
} [list "abcdefghj\n" 1 "01234" 0]
test io-13.7 {TranslateInputEOL: auto mode: naked \r} {
    # (src >= srcMax)








>











|



|








1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508

    fconfigure $f -translation crlf
    set x [read $f]
    close $f
    set x
} "abcd\ndef\nfgh"
test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio} {
    # (chanPtr->flags & INPUT_SAW_CR)
    # This test may fail on slower machines.

    set f [open "|[list $tcltest cat]" w+]
    fconfigure $f -blocking 0 -buffering none -translation {auto lf}

    fileevent $f read "ready $f"
    proc ready {f} {
	lappend ::x [read $f] [testchannel queuedcr $f]
    }
    set x {}

    puts -nonewline $f "abcdefghj\r"
    after 500 {set y ok}
    vwait y

    puts -nonewline $f "\n01234"
    after 500 {set y ok}
    vwait y

    close $f
    set x
} [list "abcdefghj\n" 1 "01234" 0]
test io-13.7 {TranslateInputEOL: auto mode: naked \r} {
    # (src >= srcMax)
︙︙
Changes to tests/load.test. 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25


26
27
28
29
30

31
32

33
34
35
36

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64

65
66
67
68
69
70
71
72
73
74
75
76

77

78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109

110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

140
141
142
143
144
145
146
147

148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169

# Commands covered:  load
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: load.test,v 1.1.2.6 1999/03/24 02:49:24 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Figure out what extension is used for shared libraries on this
# platform.

if {$tcl_platform(platform) == "macintosh"} {
    puts "can't run dynamic library tests on macintosh machines"
    return
}


set ext [info sharedlibextension]
set testDir [file join [file dirname [info nameofexecutable]] dltest]
if ![file readable [file join $testDir pkga$ext]] {
    puts "libraries in $testDir haven't been compiled: skipping tests"
    return

}


if [string match *pkga* [set alreadyLoaded [info loaded]]] {
    puts "load tests have already been run once:  skipping (can't rerun)"
    return
}


set alreadyTotalLoaded [info loaded]

test load-1.1 {basic errors} {
    list [catch {load} msg] $msg
} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
test load-1.2 {basic errors} {
    list [catch {load a b c d} msg] $msg
} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
test load-1.3 {basic errors} {
    list [catch {load a b foobar} msg] $msg
} {1 {could not find interpreter "foobar"}}
test load-1.4 {basic errors} {
    list [catch {load {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.5 {basic errors} {
    list [catch {load {} {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.6 {basic errors} {
    list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}

test load-2.1 {basic loading, with guess for package name} {

    load [file join $testDir pkga$ext]
    list [pkga_eq abc def] [info commands pkga_*]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
test load-2.2 {loading into a safe interpreter, with package name conversion} {

    load [file join $testDir pkgb$ext] pKgB child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
	    [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} {
    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg
} {1 {couldn't find procedure Foo_Init}}
test load-2.4 {loading with no _SafeInit procedure} {
    list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}

test load-3.1 {error in _Init procedure, same interpreter} {

    list [catch {load [file join $testDir pkge$ext] pkge} msg] $msg $errorInfo $errorCode

} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
"open non_existent"
    invoked from within
"if 44 {open non_existent}"
    invoked from within
"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
test load-3.2 {error in _Init procedure, slave interpreter} {

    catch {interp delete x}
    interp create x
    set errorCode foo
    set errorInfo bar
    set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
	    $msg $errorInfo $errorCode]
    interp delete x
    set result
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
"open non_existent"
    invoked from within
"if 44 {open non_existent}"
    invoked from within
"load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}

test load-4.1 {reloading package into same interpreter} {
    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
} {0 {}}
test load-4.2 {reloading package into same interpreter} {
    list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
} "1 {file \"[file join $testDir pkga$ext\"] is already loaded for package \"Pkga\"}"

test load-5.1 {file name not specified and no static package: pick default} {

    catch {interp delete x}
    interp create x
    load [file join $testDir pkga$ext] pkga
    load {} pkga x
    set result [info loaded x]
    interp delete x
    set result
} "{[file join $testDir pkga$ext] Pkga}"

# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.

test load-6.1 {errors loading file} {nonPortable} {
    catch {load foo foo}
} {1}

if {[info command teststaticpkg] != ""} {
    test load-7.1 {Tcl_StaticPackage procedure} {
	set x "not loaded"
	teststaticpkg Test 1 0
	load {} Test
	load {} Test child
	list [set x] [child eval set x]
    } {loaded loaded}
    test load-7.2 {Tcl_StaticPackage procedure} {
	set x "not loaded"
	teststaticpkg Another 0 0
	load {} Another
	child eval {set x "not loaded"}
	list [catch {load {} Another child} msg] $msg [child eval set x] [set x]

    } {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
    test load-7.3 {Tcl_StaticPackage procedure} {
	set x "not loaded"
	teststaticpkg More 0 1
	load {} More
	set x
    } {not loaded}
    test load-7.4 {Tcl_StaticPackage procedure, redundant calls} {

	teststaticpkg Double 0 1
	teststaticpkg Double 0 1
	info loaded
    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"

    test load-8.1 {TclGetLoadedPackages procedure} {
	info loaded
    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
    test load-8.2 {TclGetLoadedPackages procedure} {
	list [catch {info loaded gorp} msg] $msg
    } {1 {could not find interpreter "gorp"}}
    test load-8.3 {TclGetLoadedPackages procedure} {
	list [info loaded {}] [info loaded child]
    } "{{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}"
    test load-8.4 {TclGetLoadedPackages procedure} {
	load [file join $testDir pkgb$ext] pkgb
	list [info loaded {}] [lsort [info commands pkgb_*]]
    } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}"
    interp delete child
}

# cleanup













|












>
>


|
<
|
>
|
|
>
|
<
|
<
>



|


|


|


|


|


|



|
>




|
>




|


|



|
>
|
>







|
>
















|


|



|
>












|




|






|




|
>

|





|
>





|


|


|


|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

31
32
33
34
35
36

37

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179

# Commands covered:  load
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: load.test,v 1.1.2.7 1999/03/25 17:20:01 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

# Figure out what extension is used for shared libraries on this
# platform.

if {$tcl_platform(platform) == "macintosh"} {
    puts "can't run dynamic library tests on macintosh machines"
    return
}

# Tests require the existence of one of the DLLs in the dltest directory.
set ext [info sharedlibextension]
set testDir [file join [file dirname [info nameofexecutable]] dltest]
set x [file join $testDir pkga$ext]

set dll "[file tail $x]Required"
set ::tcltest::testConfig($dll) [file readable $x]

# Tests also require that this DLL has not already been loaded.
set loaded "[file tail $x]Loaded"
set alreadyLoaded [info loaded]

set ::tcltest::testConfig($loaded) \

	[expr {![string match *pkga* $alreadyLoaded]}]

set alreadyTotalLoaded [info loaded]

test load-1.1 {basic errors} [list $dll $loaded] {
    list [catch {load} msg] $msg
} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
test load-1.2 {basic errors} [list $dll $loaded] {
    list [catch {load a b c d} msg] $msg
} {1 {wrong # args: should be "load fileName ?packageName? ?interp?"}}
test load-1.3 {basic errors} [list $dll $loaded] {
    list [catch {load a b foobar} msg] $msg
} {1 {could not find interpreter "foobar"}}
test load-1.4 {basic errors} [list $dll $loaded] {
    list [catch {load {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.5 {basic errors} [list $dll $loaded] {
    list [catch {load {} {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.6 {basic errors} [list $dll $loaded] {
    list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}

test load-2.1 {basic loading, with guess for package name} \
	[list $dll $loaded] {
    load [file join $testDir pkga$ext]
    list [pkga_eq abc def] [info commands pkga_*]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
test load-2.2 {loading into a safe interpreter, with package name conversion} \
	[list $dll $loaded] {
    load [file join $testDir pkgb$ext] pKgB child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
	    [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} [list $dll $loaded] {
    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg
} {1 {couldn't find procedure Foo_Init}}
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}

test load-3.1 {error in _Init procedure, same interpreter} \
	[list $dll $loaded] {
    list [catch {load [file join $testDir pkge$ext] pkge} msg] \
	    $msg $errorInfo $errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
"open non_existent"
    invoked from within
"if 44 {open non_existent}"
    invoked from within
"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
test load-3.2 {error in _Init procedure, slave interpreter} \
	[list $dll $loaded] {
    catch {interp delete x}
    interp create x
    set errorCode foo
    set errorInfo bar
    set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
	    $msg $errorInfo $errorCode]
    interp delete x
    set result
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
"open non_existent"
    invoked from within
"if 44 {open non_existent}"
    invoked from within
"load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}

test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
} {0 {}}
test load-4.2 {reloading package into same interpreter} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
} "1 {file \"[file join $testDir pkga$ext\"] is already loaded for package \"Pkga\"}"

test load-5.1 {file name not specified and no static package: pick default} \
	[list $dll $loaded] {
    catch {interp delete x}
    interp create x
    load [file join $testDir pkga$ext] pkga
    load {} pkga x
    set result [info loaded x]
    interp delete x
    set result
} "{[file join $testDir pkga$ext] Pkga}"

# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.

test load-6.1 {errors loading file} [list $dll $loaded nonPortable] {
    catch {load foo foo}
} {1}

if {[info command teststaticpkg] != ""} {
    test load-7.1 {Tcl_StaticPackage procedure} [list $dll $loaded] {
	set x "not loaded"
	teststaticpkg Test 1 0
	load {} Test
	load {} Test child
	list [set x] [child eval set x]
    } {loaded loaded}
    test load-7.2 {Tcl_StaticPackage procedure} [list $dll $loaded] {
	set x "not loaded"
	teststaticpkg Another 0 0
	load {} Another
	child eval {set x "not loaded"}
	list [catch {load {} Another child} msg] $msg \
		[child eval set x] [set x]
    } {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
    test load-7.3 {Tcl_StaticPackage procedure} [list $dll $loaded] {
	set x "not loaded"
	teststaticpkg More 0 1
	load {} More
	set x
    } {not loaded}
    test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
	    [list $dll $loaded] {
	teststaticpkg Double 0 1
	teststaticpkg Double 0 1
	info loaded
    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"

    test load-8.1 {TclGetLoadedPackages procedure} [list $dll $loaded] {
	info loaded
    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
    test load-8.2 {TclGetLoadedPackages procedure} [list $dll $loaded] {
	list [catch {info loaded gorp} msg] $msg
    } {1 {could not find interpreter "gorp"}}
    test load-8.3 {TclGetLoadedPackages procedure} [list $dll $loaded] {
	list [info loaded {}] [info loaded child]
    } "{{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}"
    test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded] {
	load [file join $testDir pkgb$ext] pkgb
	list [info loaded {}] [lsort [info commands pkgb_*]]
    } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}"
    interp delete child
}

# cleanup
︙︙
This page was generated in about 0.044s by Fossil 2.27 [a6d506ecc4] 2025-07-09 13:52:53