Tcl Source Code

Check-in [959b030de5]
Login

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

Overview
Comment:* tests/http.test: Fixed bad test initialization code.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 959b030de5787bcb5d82acfc908ab55c68ce4326
User & Date: stanton 1999-04-03 01:19:53.000
Context
1999-04-03
01:19
*** empty log message *** check-in: 11b0722d47 user: stanton tags: core-8-1-branch-old
01:19
* tests/http.test: Fixed bad test initialization code. check-in: 959b030de5 user: stanton tags: core-8-1-branch-old
01:19
* generic/tclThreadTest.c (ThreadExitProc): Fixed bug where static memory was being returned instead... check-in: 580aaa126e user: stanton tags: core-8-1-branch-old
Changes
Unified Diff Ignore Whitespace Patch
Changes to tests/http.test.
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# Copyright (c) 1994-1996 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: http.test,v 1.1.2.7 1999/04/02 18:57:08 hershey Exp $

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

if {[catch {package require http 2.0}]} {
    if {[info exist http2]} {







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
# Copyright (c) 1994-1996 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: http.test,v 1.1.2.8 1999/04/03 01:19:53 stanton Exp $

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

if {[catch {package require http 2.0}]} {
    if {[info exist http2]} {
34
35
36
37
38
39
40
41
42
43
44

45
46
47
48
49
50
51


set port 8010
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"

set httpdFile [file join $::tcltest::testsDir httpd]
if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
    set httpthread [testthread create {
	source $httpdFile
	testthread wait
    }]

    testthread send $httpthread [list set port $port]
    testthread send $httpthread [list set bindata $bindata]
    testthread send $httpthread {httpd_init $port}
    puts "Running httpd in thread $httpthread"
} else {
    if ![file exists $httpdFile] {
	puts "Cannot read $httpdFile script, http test skipped"







|


<
>







34
35
36
37
38
39
40
41
42
43

44
45
46
47
48
49
50
51


set port 8010
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"

set httpdFile [file join $::tcltest::testsDir httpd]
if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
    set httpthread [testthread create "
	source $httpdFile
	testthread wait

    "]
    testthread send $httpthread [list set port $port]
    testthread send $httpthread [list set bindata $bindata]
    testthread send $httpthread {httpd_init $port}
    puts "Running httpd in thread $httpthread"
} else {
    if ![file exists $httpdFile] {
	puts "Cannot read $httpdFile script, http test skipped"