Tcl Source Code

Check-in [7f362b47fb]
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:Plug most memory leaks in thread.test.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7f362b47fb2a5f97e0bfec17f590340b39718fe9
User & Date: dgp 2011-09-19 17:46:07
Context
2011-09-19
20:30
Conversion from [testthread] to Thread package stops most memory leaks. check-in: b284fade78 user: dgp tags: trunk
17:46
Plug most memory leaks in thread.test. check-in: 7f362b47fb user: dgp tags: trunk
17:19
Plug all memory leaks in ioCmd.test exposed by `make valgrind`. check-in: cc4f894e4a user: dgp tags: trunk
2011-09-12
17:52
stop segfault Closed-Leaf check-in: eeddaf97df user: dgp tags: thread-leaks
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.

1







2
3
4
5
6
7
8
2011-09-15  Don Porter  <[email protected]>








	* generic/tclIORChan.c:	Plug all memory leaks in ioCmd.test exposed
	* tests/ioCmd.test:	by `make valgrind`.
	* unix/Makefile.in:

2011-09-16  Jan Nijtmans  <[email protected]>

>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
2011-09-15  Don Porter  <[email protected]>

	* tests/thread.test:	Plug most memory leaks in thread.test  Constrain
	the rest to be skipped during `make valgrind`.  Tests using the
	[testthread cancel] testing command are leaky.  Corrections wait for
	either addition of [thread::cancel] to the Thread package, or improvements
	to the [testthread] testing command to make leak-free versions of these
	tests possible.

	* generic/tclIORChan.c:	Plug all memory leaks in ioCmd.test exposed
	* tests/ioCmd.test:	by `make valgrind`.
	* unix/Makefile.in:

2011-09-16  Jan Nijtmans  <[email protected]>

Changes to tests/thread.test.

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
...
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
...
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
...
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
...
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
....
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
....
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
....
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
}

# 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 1 {eval unwound}}
test thread-7.24 {cancel: nested catch inside pure bytecode loop} {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
................................................................................
    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.25 {cancel: nested catch inside pure inside-command loop} {testthread} {
    threadReap
    unset -nocomplain ::threadError ::threadId ::threadIdStarted
    set serverthread [testthread create -joinable {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {
................................................................................
    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
................................................................................
    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 1 {eval canceled}}
test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {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
................................................................................
    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.29 {cancel: send async cancel nested catch pure inside-command loop} {testthread} {
    threadReap
    unset -nocomplain ::threadError ::threadId ::threadIdStarted
    set serverthread [testthread create -joinable {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {
................................................................................
    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.30 {cancel: send async testthread cancel nested catch inside pure bytecode loop} {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
................................................................................
    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.31 {cancel: send async testthread cancel nested catch pure inside-command loop} {testthread} {
    threadReap
    unset -nocomplain ::threadError ::threadId ::threadIdStarted
    set serverthread [testthread create -joinable {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {






>
>


>
>
>
>










<







 







|







 







|







 







|
<
|
|
>





|
|






|


|
|
>







 







|







 







|







 







|







 







|







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
...
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
...
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
...
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
974
975
....
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
....
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
....
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
....
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
}

# Some tests require the testthread command

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

testConstraint notValgrind [expr {![testConstraint valgrind]}]

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 1 {eval unwound}}
test thread-7.24 {cancel: nested catch inside pure bytecode loop} {notValgrind 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
................................................................................
    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.25 {cancel: nested catch inside pure inside-command loop} {notValgrind testthread} {
    threadReap
    unset -nocomplain ::threadError ::threadId ::threadIdStarted
    set serverthread [testthread create -joinable {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {
................................................................................
    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
................................................................................
    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 1 {eval canceled}}
test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {notValgrind 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
................................................................................
    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.29 {cancel: send async cancel nested catch pure inside-command loop} {notValgrind testthread} {
    threadReap
    unset -nocomplain ::threadError ::threadId ::threadIdStarted
    set serverthread [testthread create -joinable {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {
................................................................................
    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.30 {cancel: send async testthread cancel nested catch inside pure bytecode loop} {notValgrind 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
................................................................................
    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.31 {cancel: send async testthread cancel nested catch pure inside-command loop} {notValgrind testthread} {
    threadReap
    unset -nocomplain ::threadError ::threadId ::threadIdStarted
    set serverthread [testthread create -joinable {
	proc foobar {} {
	    set catch catch
	    set while while
	    $while {1} {