Tcl Source Code

Check-in [4466e490d8]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

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

Overview
Comment:Remove unnecessary after calls from the thread tests. Make error message matching more robust for tests that may have built-in race conditions. Test thread-7.26 must first unset all thread testing related variables.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 4466e490d86afb90c2230b162a965be2e9714a8c
User & Date: mistachkin 2011-11-21 01:26:27
Context
2011-11-21
05:51
Revise results of the thread-7.28 through thread-7.31 tests to account for the fact they are cancele... check-in: 0201686f93 user: mistachkin tags: trunk
01:26
Remove unnecessary after calls from the thread tests. Make error message matching more robust for... check-in: 4466e490d8 user: mistachkin tags: trunk
2011-11-18
12:11
Remove all use of thread::release from the thread 7.x tests, replacing it with a script that can eas... check-in: d4b7c74d47 user: mistachkin tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 








1
2
3
4
5
6
7








2011-11-18  Joe Mistachkin  <[email protected]>

	* tests/thread.test: Remove all use of thread::release from the thread
	7.x tests, replacing it with a script that can easily cause "stuck"
	threads to self-destruct for those test cases that require it.  Also,
	make the error message handling far more robust by keeping track of
	every asynchronous error.

>
>
>
>
>
>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14

2011-11-20  Joe Mistachkin  <[email protected]>

	* tests/thread.test: Remove unnecessary [after] calls from the thread
	tests.  Make error message matching more robust for tests that may
	have built-in race conditions.  Test thread-7.26 must first unset all
	thread testing related variables.

2011-11-18  Joe Mistachkin  <[email protected]>

	* tests/thread.test: Remove all use of thread::release from the thread
	7.x tests, replacing it with a script that can easily cause "stuck"
	threads to self-destruct for those test cases that require it.  Also,
	make the error message handling far more robust by keeping track of
	every asynchronous error.
︙︙

Changes to tests/thread.test.

︙︙
25
26
27
28
29
30
31

32
33
34
35
36




37







38
39
40
41
42
43
44

testConstraint thread [expr {0 == [catch {package require Thread 2.7}]}]

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

set threadSuperKillScript {
    rename catch ""
    rename while ""

    rename update ""
    thread::release
}

proc getThreadError { info } {




    return [lindex [split [lindex $info 0] \n] 0]







}

proc ThreadError {id info} {
    global threadId threadError
    set threadId $id
    lappend threadError($id) $info
}








>





>
>
>
>
|
>
>
>
>
>
>
>








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

testConstraint thread [expr {0 == [catch {package require Thread 2.7}]}]

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

set threadSuperKillScript {
    rename catch ""
    rename while ""
    rename unknown ""
    rename update ""
    thread::release
}

proc getThreadError { info } {
    foreach error [lreverse $info] {
        set list [split $error \n]
        set idx [lsearch -glob $list "*eval*unwound*"]
        if {$idx != -1} then {
          return [lindex $list $idx]
        }
        set idx [lsearch -glob $list "*eval*canceled*"]
        if {$idx != -1} then {
          return [lindex $list $idx]
        }
    }
    return ""; # some other error we do not care about.
}

proc ThreadError {id info} {
    global threadId threadError
    set threadId $id
    lappend threadError($id) $info
}
︙︙
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::cancel $serverthread]
    after 1000; # wait for ThreadErrorProc to be called.
    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \








<








837
838
839
840
841
842
843

844
845
846
847
848
849
850

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::cancel $serverthread]

    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
︙︙
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::cancel $serverthread]
    after 1000; # wait for ThreadErrorProc to be called.
    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
		  [getThreadError $::threadError($serverthread)] : "" }]
} {{} 1 0 {}}
test thread-7.26 {cancel: send async cancel bad interp path} {thread} {
    unset -nocomplain ::threadIdStarted
    set serverthread [thread::create -joinable \
	[string map [list %ID% [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).








<










|








878
879
880
881
882
883
884

885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::cancel $serverthread]

    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
		  [getThreadError $::threadError($serverthread)] : "" }]
} {{} 1 0 {}}
test thread-7.26 {cancel: send async cancel bad interp path} {thread} {
    unset -nocomplain ::threadError ::threadId ::threadIdStarted
    set serverthread [thread::create -joinable \
	[string map [list %ID% [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).
︙︙
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {interp cancel}]
    after 1000; # wait for ThreadErrorProc to be called.
    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \








<








974
975
976
977
978
979
980

981
982
983
984
985
986
987

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {interp cancel}]

    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
︙︙
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {interp cancel}]
    after 1000; # wait for ThreadErrorProc to be called.
    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \








<








1015
1016
1017
1018
1019
1020
1021

1022
1023
1024
1025
1026
1027
1028

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {interp cancel}]

    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
︙︙
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
    after 1000; # wait for ThreadErrorProc to be called.
    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \








<








1054
1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {thread::cancel [thread::id]}]

    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
︙︙
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
    after 1000; # wait for ThreadErrorProc to be called.
    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \








<








1095
1096
1097
1098
1099
1100
1101

1102
1103
1104
1105
1106
1107
1108

	    }
	}
	foobar
    }]]
    # wait for other thread to signal "ready to cancel"
    vwait ::threadIdStarted; after 1000
    set res [thread::send -async $serverthread {thread::cancel [thread::id]}]

    thread::send $serverthread $::threadSuperKillScript
    thread::join $serverthread
    list $res [expr {[info exists ::threadIdStarted] ? \
		  $::threadIdStarted == $serverthread : 0}] \
	      [expr {[info exists ::threadId] ? \
		  $::threadId == $serverthread : 0}] \
	      [expr {[info exists ::threadError($serverthread)] ? \
︙︙

This page was generated in about 0.027s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19