Tcl Source Code

Check-in [e605829c9f]
Login

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

Overview
Comment:* tests/httpold.test: Fixed broken test that didn't wait long enough for events to arrive.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: e605829c9f5fad81336276db9a5667da74914234
User & Date: stanton 1999-04-07 00:39:10.000
Context
1999-04-07
00:39
*** empty log message *** check-in: 0af570ed2d user: stanton tags: core-8-1-branch-old
00:39
* tests/httpold.test: Fixed broken test that didn't wait long enough for events to arrive. check-in: e605829c9f user: stanton tags: core-8-1-branch-old
00:36
Minor fix to dist scripts man page lint check-in: 505aa70cdc user: stanton tags: core-8-1-branch-old
Changes
Unified Diff Ignore Whitespace Patch
Changes to tests/httpold.test.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Commands covered:  http_config, http_get, http_wait, http_reset
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# 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: httpold.test,v 1.1.2.8 1999/04/05 23:34:44 welch Exp $

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

if {[catch {package require http 1.0}]} {
    if {[info exist httpold]} {













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Commands covered:  http_config, http_get, http_wait, http_reset
#
# This file contains a collection of tests for the http script library.
# Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# 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: httpold.test,v 1.1.2.9 1999/04/07 00:39:10 stanton Exp $

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

if {[catch {package require http 1.0}]} {
    if {[info exist httpold]} {
385
386
387
388
389
390
391


392
393
394
395
396
397
398
399
400
401
402
403
404
405
test http-4.11 {httpEvent} {
    set token [http_get $url -timeout 1 -command {#}]
    http_reset $token
    http_status $token
} {reset}
test http-4.12 {httpEvent} {
    update


    set token [http_get $url -timeout 1 -command {#}]
    # This combo of update and after 10 is an effort
    # to let enough events get through the event loop.
    update
    after 10
    http_status $token
} {timeout}

test http-5.1 {http_formatQuery} {
    http_formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value+two}

test http-5.2 {http_formatQuery} {
    http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2







>
>
|
<
<
|
<
|
|







385
386
387
388
389
390
391
392
393
394


395

396
397
398
399
400
401
402
403
404
test http-4.11 {httpEvent} {
    set token [http_get $url -timeout 1 -command {#}]
    http_reset $token
    http_status $token
} {reset}
test http-4.12 {httpEvent} {
    update
    set x {}
    after 500 {lappend x ok}
    set token [http_get $url -timeout 1 -command {lappend x fail}]


    vwait x

    list [http_status $token] $x
} {timeout ok}

test http-5.1 {http_formatQuery} {
    http_formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value+two}

test http-5.2 {http_formatQuery} {
    http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2