Tcl Source Code

Check-in [2745684dbf]
Login

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

Overview
Comment:Fixed race condition in test.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 2745684dbf0819661f31244794787de679094e85
User & Date: stanton 1999-04-06 20:40:22.000
Context
1999-04-06
20:59
Adjusted error reporting in TclpRename to better handle common error condition on IRIX. The change... check-in: b03aba6368 user: rjohnson tags: core-8-1-branch-old
20:40
Fixed race condition in test. check-in: 2745684dbf user: stanton tags: core-8-1-branch-old
20:39
Added knownBug tag to test that in known to fail (Bug: 1737) check-in: 6985e168ac user: surles tags: core-8-1-branch-old
Changes
Unified Diff Ignore Whitespace Patch
Changes to ChangeLog.
1
2


3
4
5
6
7
8
9
1999-04-06    <[email protected]>



	* tests/unixInit.test: 
	* tests/fileName.test: Minor test nits.

	* unix/tclUnixInit.c (TclpSetInitialEncodings): Fixed bad initial
	encoding string.

1999-04-06    <[email protected]>

|
>
>







1
2
3
4
5
6
7
8
9
10
11
1999-04-06    <[email protected]>
	
	* tests/unixInit.test: Fixed race condition in test.
	
	* tests/unixInit.test: 
	* tests/fileName.test: Minor test nits.

	* unix/tclUnixInit.c (TclpSetInitialEncodings): Fixed bad initial
	encoding string.

1999-04-06    <[email protected]>
Changes to tests/unixInit.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# The file tests the functions in the tclUnixInit.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# 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: unixInit.test,v 1.1.2.8 1999/04/06 20:21:26 stanton Exp $

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

catch {set oldlibrary $env(TCL_LIBRARY); unset env(TCL_LIBRARY)}
catch {set oldlang $env(LANG)}












|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
# The file tests the functions in the tclUnixInit.c file.
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# 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: unixInit.test,v 1.1.2.9 1999/04/06 20:40:23 stanton Exp $

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

catch {set oldlibrary $env(TCL_LIBRARY); unset env(TCL_LIBRARY)}
catch {set oldlang $env(LANG)}
31
32
33
34
35
36
37



38



39
40
41
42



43
44
45
46
47
48
49
} else {
    set ::tcltest::testConfig(installedTcl) 1
}

test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} {
    set x {}




    set f [open "|[list $tcltest]" w+]



    exec kill -PIPE [pid $f]
    lappend x [catch {close $f}]

    set f [open "|[list $tcltest]" w+]



    exec kill [pid $f]
    lappend x [catch {close $f}]

    set x
} {0 1}

proc getlibpath "{program [list $tcltest]}" {







>
>
>

>
>
>




>
>
>







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
} else {
    set ::tcltest::testConfig(installedTcl) 1
}

test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unixOnly installedTcl} {
    set x {}

    # Watch out for a race condition here.  If tcltest is too slow to start
    # then we'll kill it before it has a chance to set up its signal handler.
    
    set f [open "|[list $tcltest]" w+]
    puts $f "puts hi"
    flush $f
    gets $f
    exec kill -PIPE [pid $f]
    lappend x [catch {close $f}]

    set f [open "|[list $tcltest]" w+]
    puts $f "puts hi"
    flush $f
    gets $f
    exec kill [pid $f]
    lappend x [catch {close $f}]

    set x
} {0 1}

proc getlibpath "{program [list $tcltest]}" {