Tcl Source Code

Changes On Branch thread-leaks
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Changes In Branch thread-leaks Excluding Merge-Ins

This is equivalent to a diff from f764b99f81 to eeddaf97df

2011-09-19
17:46
Plug most memory leaks in thread.test. check-in: 7f362b47fb user: dgp tags: trunk
2011-09-13
18:27
3405652 Portability workaround for broken system DTrace support. Thanks to Dagobert Michelson. check-in: d9f5e84500 user: dgp tags: trunk
2011-09-12
17:52
stop segfault Closed-Leaf check-in: eeddaf97df user: dgp tags: thread-leaks
16:19
Attempt to convert test thread-7.26 check-in: 0c36f08d9f user: dgp tags: thread-leaks
10:26
[Bug 3407070] tclPosixStr.c won't build with EOVERFLOW==E2BIG check-in: f764b99f81 user: jan.nijtmans tags: trunk
10:12
[Bug 3407070] tclPosixStr.c won't build with EOVERFLOW==E2BIG check-in: d3fba70ec1 user: jan.nijtmans tags: core-8-5-branch
05:06
more conversion work check-in: 5d0b07dbeb user: dgp tags: trunk

Changes to tests/thread.test.

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
...
934
935
936
937
938
939
940
941
942
943
944

945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962

963
964
965
966
967
968
969
# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] != {}}]
testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}]

if {[testConstraint testthread]} {
    testthread errorproc ThreadError





    proc ThreadError {id info} {
	global threadId threadError
	set threadId $id
	set threadError $info
    }

    proc ThreadNullError {id info} {
	# ignore
    }
}


test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
    list [catch {testthread} msg] $msg
} {1 {wrong # args: should be "testthread option ?arg ...?"}}
test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
    list [catch {testthread foo} msg] $msg
................................................................................
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError] ? \
		  [lindex [split $::threadError \n] 0] : "" }]
} {{} 1 0 {}}
test thread-7.26 {cancel: send async cancel bad interp path} {testthread} {
    threadReap
    unset -nocomplain ::threadError ::threadId ::threadIdStarted
    set serverthread [testthread create -joinable {

	proc foobar {} {
	    while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    testthread send [testthread id -main] \
			    [list set ::threadIdStarted [testthread id]]
		    set foo 1
		}
		update
	    }
	}
	foobar
    }]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    catch {testthread send $serverthread {interp cancel -- bad}} msg
    threadReap

    list [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
		  $msg
} {1 {could not find interpreter "bad"}}
test thread-7.27 {cancel: send async cancel -- switch} {testthread} {
    threadReap
    unset -nocomplain ::threadError ::threadId ::threadIdStarted






>
>
>
>










<







 







|
<
|
|
>





|
|






|


|
|
>







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
...
937
938
939
940
941
942
943
944

945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] != {}}]
testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}]

if {[testConstraint testthread]} {
    testthread errorproc ThreadError
}
if {[testConstraint thread]} {
    thread::errorproc ThreadError
}

    proc ThreadError {id info} {
	global threadId threadError
	set threadId $id
	set threadError $info
    }

    proc ThreadNullError {id info} {
	# ignore
    }



test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
    list [catch {testthread} msg] $msg
} {1 {wrong # args: should be "testthread option ?arg ...?"}}
test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
    list [catch {testthread foo} msg] $msg
................................................................................
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError] ? \
		  [lindex [split $::threadError \n] 0] : "" }]
} {{} 1 0 {}}
test thread-7.26 {cancel: send async cancel bad interp path} {thread} {

    unset -nocomplain ::threadIdStarted
    set serverthread [thread::create -preserved \
	[string map [list MAIN [thread::id]] {
	proc foobar {} {
	    while {1} {
		if {![info exists foo]} then {
		    # signal the primary thread that we are ready
		    # to be canceled now (we are running).
		    thread::send MAIN \
			    [list set ::threadIdStarted [thread::id]]
		    set foo 1
		}
		update
	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    catch {thread::send $serverthread {interp cancel -- bad}} msg
    thread::send -async $serverthread {interp cancel -unwind}
    thread::release -wait $serverthread
    list [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
		  $msg
} {1 {could not find interpreter "bad"}}
test thread-7.27 {cancel: send async cancel -- switch} {testthread} {
    threadReap
    unset -nocomplain ::threadError ::threadId ::threadIdStarted