Tcl Source Code

Check-in [50bfe2a9a5]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Added test for BUG 1327. Improved the way yeilding is done in thread tests.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 50bfe2a9a5187d208375b2f2acdd3f41e5e6bfb3
User & Date: welch 1999-04-01 23:22:32
Context
1999-04-01
23:23
Added file used with test for BUG 1327 check-in: a2c1963b2c user: welch tags: core-8-1-branch-old
23:22
Added test for BUG 1327. Improved the way yeilding is done in thread tests. check-in: 50bfe2a9a5 user: welch tags: core-8-1-branch-old
23:21
Fixed BUG 1327 with scripts that do namespace imports. check-in: 40c369355a user: welch tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/pkgMkIndex.test.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
339
340
341
342
343
344
345






346
347
348
349
350
351
352
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: pkgMkIndex.test,v 1.4.2.7 1999/03/25 04:32:18 hershey Exp $

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

# temporarily copy the pkg and pkg1 dirs from testsDir to tmpDir
if {"$::tcltest::testsDir" != "$::tcltest::workingDir"} {
................................................................................
    file copy -force $x pkg
    pkgtest::runIndex pkg pkga[info sharedlibextension] pkga.tcl
} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
test pkgMkIndex-10.2 {package in DLL hidden by -load} $dll {
    pkgtest::runIndex -load Pkg* -- pkg pkga[info sharedlibextension]
} {0 {}}







# cleanup
namespace delete pkgtest
cd $::tcltest::workingDir
if {[info exists removePkgDir]} {
    # strange error deleting the pkg dir only once--needs be done twice!
    catch {file delete -force $newPkgDir}
    catch {file delete -force $newPkgDir}






|







 







>
>
>
>
>
>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
#
# Sourcing this file into Tcl runs the tests and generates output for
# errors.  No output means no errors were found.
#
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: pkgMkIndex.test,v 1.4.2.8 1999/04/01 23:22:32 welch Exp $

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

# temporarily copy the pkg and pkg1 dirs from testsDir to tmpDir
if {"$::tcltest::testsDir" != "$::tcltest::workingDir"} {
................................................................................
    file copy -force $x pkg
    pkgtest::runIndex pkg pkga[info sharedlibextension] pkga.tcl
} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
test pkgMkIndex-10.2 {package in DLL hidden by -load} $dll {
    pkgtest::runIndex -load Pkg* -- pkg pkga[info sharedlibextension]
} {0 {}}

# Tolerate "namespace import" at the global scope

test pkgMkIndex-11.1 {conflicting namespace imports} {
    pkgtest::runIndex pkg import.tcl
} {0 {{fubar:1.0 {tclPkgSetup {import.tcl source ::fubar::foo}}}}}

# cleanup
namespace delete pkgtest
cd $::tcltest::workingDir
if {[info exists removePkgDir]} {
    # strange error deleting the pkg dir only once--needs be done twice!
    catch {file delete -force $newPkgDir}
    catch {file delete -force $newPkgDir}

Changes to tests/thread.test.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
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
#
# Copyright (c) 1996 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: thread.test,v 1.1.2.5 1999/03/26 19:14:07 hershey Exp $

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

if {[info command testthread] == ""} {
    puts "skipping: tests require the testthread command"
................................................................................
    set numthreads [llength [testthread names]]
} {2}
ThreadReap

test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {
    testthread create {set x 5}
    foreach try {0 1 2 4 5 6} {

	update

	set l [llength [testthread names]]
	if {$l == 1} {
	    break
	}
    }
    set l
} {1}
ThreadReap

test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {
    testthread create {testthread exit}
    update

    llength [testthread names]
} {1}
ThreadReap

test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {
    set x [catch {testthread id x} msg]
    list $x $msg






|







 







>

>












>







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
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
#
# Copyright (c) 1996 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: thread.test,v 1.1.2.6 1999/04/01 23:22:32 welch Exp $

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

if {[info command testthread] == ""} {
    puts "skipping: tests require the testthread command"
................................................................................
    set numthreads [llength [testthread names]]
} {2}
ThreadReap

test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {
    testthread create {set x 5}
    foreach try {0 1 2 4 5 6} {
	# Try various ways to yeild
	update
	after 10
	set l [llength [testthread names]]
	if {$l == 1} {
	    break
	}
    }
    set l
} {1}
ThreadReap

test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {
    testthread create {testthread exit}
    update
    after 10
    llength [testthread names]
} {1}
ThreadReap

test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {
    set x [catch {testthread id x} msg]
    list $x $msg