Tcl Source Code

Check-in [cf698a5352]
Login

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

Overview
Comment:Fixed httpold 4.12
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: cf698a535225488a169199e71e9072423d0ec8d6
User & Date: welch 1999-04-05 23:34:44.000
Context
1999-04-06
00:01
Fixed test that would only work with debug builds. check-in: ead92ba131 user: rjohnson tags: core-8-1-branch-old
1999-04-05
23:34
Fixed httpold 4.12 check-in: cf698a5352 user: welch tags: core-8-1-branch-old
23:14
*** empty log message *** check-in: 044e1720ab 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.7 1999/04/02 23:44:38 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]} {













|







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]} {
385
386
387
388
389
390
391
392
393


394

395
396
397
398
399
400
401
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
    after 1000 {set x 1}
    set token [http_get $url -timeout 1 -command {#}]


    vwait x

    http_status $token
} {timeout}

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








<

>
>
|
>







385
386
387
388
389
390
391

392
393
394
395
396
397
398
399
400
401
402
403
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}