Tcl Source Code

Check-in [acc054dca8]
Login
Core Home Timeline Branches Tags Tickets Wiki Clone or Download
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Fixed hang in tests when built with thread support.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: acc054dca88f9e380bc113343c4043df4f02f96c
User & Date: stanton 1999-04-07 01:29:26
Context
1999-04-07
01:59
change tcltest namespace variables from matchingTests and skippingTests to match and skip.

removed ... check-in: 043d97f05e user: hershey tags: core-8-1-branch-old

01:29
Fixed hang in tests when built with thread support. check-in: acc054dca8 user: stanton tags: core-8-1-branch-old
00:39
*** empty log message *** check-in: 0af570ed2d user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 

1



2
3
4
5
6
7
8

1999-04-06    <[email protected]>




	* tests/httpold.test: Fixed broken test that didn't wait long
	enough for events to arrive.

	* tests/unixInit.test: Fixed race condition in test.
	
	* tests/unixInit.test: 

>
>
>








1
2
3
4
5
6
7
8
9
10
11

1999-04-06    <[email protected]>

	* tests/unixNotfy.test: Fixed hang in tests when built with thread
	support. 

	* tests/httpold.test: Fixed broken test that didn't wait long
	enough for events to arrive.

	* tests/unixInit.test: Fixed race condition in test.
	
	* tests/unixInit.test:

Changes to tests/unixNotfy.test. 

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

#
# Copyright (c) 1997 by 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: unixNotfy.test,v 1.1.2.7 1999/04/02 18:59:07 hershey Exp $

# The tests should not be run if you have a notifier which is unable to
# detect infinite vwaits, as the tests below will hang. The presence of
# the "testthread" command indicates that this is the case.

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

if {[lsearch [info commands testthread] testthread] == -1} {
    puts "skipping: tests require the testthread command..."
    ::tcltest::cleanupTests
    return
}

test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly} {

    catch {vwait x}
    set f [open foo w]
    fileevent $f writable {set x 1}
    vwait x
    close $f
    list [catch {vwait x} msg] $msg
} {1 {can't wait for variable "x":  would wait forever}}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly} {
    catch {vwait x}
    set f1 [open foo w]
    set f2 [open foo2 w]
    fileevent $f1 writable {set x 1}
    fileevent $f2 writable {set y 1}
    vwait x
    close $f1
    vwait y
    close $f2
    list [catch {vwait x} msg] $msg
} {1 {can't wait for variable "x":  would wait forever}}

































# cleanup
file delete foo
file delete foo2
::tcltest::cleanupTests
return








|









|
|
|
|
|
|
|
>







|











>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








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

#
# Copyright (c) 1997 by 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: unixNotfy.test,v 1.1.2.8 1999/04/07 01:29:27 stanton Exp $

# The tests should not be run if you have a notifier which is unable to
# detect infinite vwaits, as the tests below will hang. The presence of
# the "testthread" command indicates that this is the case.

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

set ::tcltest::testConfig(testthread) \
	[expr {[info commands testthread] != {}}]

# The next two tests will hang if threads are enabled because the notifier
# will not necessarily wait for ever in this case, so it does not generate
# an error.

test unixNotfy-1.1 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
    catch {vwait x}
    set f [open foo w]
    fileevent $f writable {set x 1}
    vwait x
    close $f
    list [catch {vwait x} msg] $msg
} {1 {can't wait for variable "x":  would wait forever}}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly && !testthread} {
    catch {vwait x}
    set f1 [open foo w]
    set f2 [open foo2 w]
    fileevent $f1 writable {set x 1}
    fileevent $f2 writable {set y 1}
    vwait x
    close $f1
    vwait y
    close $f2
    list [catch {vwait x} msg] $msg
} {1 {can't wait for variable "x":  would wait forever}}


test unixNotfy-2.1 {Tcl_DeleteFileHandler} {unixOnly testthread} {
    update
    set f [open foo w]
    fileevent $f writable {set x 1}
    vwait x
    close $f
    testthread create "after 500
    testthread send [testthread id] {set x ok}
    testthread exit"
    vwait x
    set x
} {ok}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} {unixOnly testthread} {
    update
    set f1 [open foo w]
    set f2 [open foo2 w]
    fileevent $f1 writable {set x 1}
    fileevent $f2 writable {set y 1}
    vwait x
    close $f1
    vwait y
    close $f2
    testthread create "after 500
    testthread send [testthread id] {set x ok}
    testthread exit"
    vwait x
    set x
} {ok}



# cleanup
file delete foo
file delete foo2
::tcltest::cleanupTests
return

This page was generated in about 0.014s by Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14