📄 httpold.test

📁 tcl是工具命令语言
💻 TEST
字号:
# 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.11 2002/10/03 13:34:32 dkf Exp $if {[lsearch [namespace children] ::tcltest] == -1} {    package require tcltest    namespace import -force ::tcltest::*}if {[catch {package require http 1.0}]} {    if {[info exists httpold]} {	catch {puts "Cannot load http 1.0 package"}	::tcltest::cleanupTests	return    } else {	catch {puts "Running http 1.0 tests in slave interp"}	set interp [interp create httpold]	$interp eval [list set httpold "running"]	$interp eval [list set argv $argv]	$interp eval [list source [info script]]	interp delete $interp	::tcltest::cleanupTests	return    }}set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"catch {unset data}## ## The httpd script implement a stub http server##source [file join [file dirname [info script]] httpd]set port 8010if [catch {httpd_init $port} listen] {    puts "Cannot start http server, http test skipped"    unset port    ::tcltest::cleanupTests    return}test httpold-1.1 {http_config} {    http_config} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}test httpold-1.2 {http_config} {    http_config -proxyfilter} httpProxyRequiredtest httpold-1.3 {http_config} {    catch {http_config -junk}} 1test httpold-1.4 {http_config} {    http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"    set x [http_config]    http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \	-useragent "Tcl http client package 1.0"    set x} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}test httpold-1.5 {http_config} {    catch {http_config -proxyhost {} -junk 8080}} 1test httpold-2.1 {http_reset} {    catch {http_reset http#1}} 0test httpold-3.1 {http_get} {    catch {http_get -bogus flag}} 1test httpold-3.2 {http_get} {    catch {http_get http:junk} err    set err} {Unsupported URL: http:junk}set url [info hostname]:$porttest httpold-3.3 {http_get} {    set token [http_get $url]    http_data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET /</h2></body></html>"set tail /a/b/cset url [info hostname]:$port/a/b/cset binurl [info hostname]:$port/binarytest httpold-3.4 {http_get} {    set token [http_get $url]    http_data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET $tail</h2></body></html>"proc selfproxy {host} {    global port    return [list [info hostname] $port]}test httpold-3.5 {http_get} {    http_config -proxyfilter selfproxy    set token [http_get $url]    http_config -proxyfilter httpProxyRequired    http_data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET http://$url</h2></body></html>"test httpold-3.6 {http_get} {    http_config -proxyfilter bogus    set token [http_get $url]    http_config -proxyfilter httpProxyRequired    http_data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET $tail</h2></body></html>"test httpold-3.7 {http_get} {    set token [http_get $url -headers {Pragma no-cache}]    http_data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET $tail</h2></body></html>"test httpold-3.8 {http_get} {    set token [http_get $url -query Name=Value&Foo=Bar]    http_data $token} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>POST $tail</h2><h2>Query</h2><dl><dt>Name<dd>Value<dt>Foo<dd>Bar</dl></body></html>"test httpold-3.9 {http_get} {    set token [http_get $url -validate 1]    http_code $token} "HTTP/1.0 200 OK"test httpold-4.1 {httpEvent} {    set token [http_get $url]    upvar #0 $token data    array set meta $data(meta)    expr ($data(totalsize) == $meta(Content-Length))} 1test httpold-4.2 {httpEvent} {    set token [http_get $url]    upvar #0 $token data    array set meta $data(meta)    string compare $data(type) [string trim $meta(Content-Type)]} 0test httpold-4.3 {httpEvent} {    set token [http_get $url]    http_code $token} {HTTP/1.0 200 Data follows}test httpold-4.4 {httpEvent} {    set testfile [makeFile "" testfile]    set out [open $testfile w]    set token [http_get $url -channel $out]    close $out    set in [open $testfile]    set x [read $in]    close $in    removeFile $testfile    set x} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET $tail</h2></body></html>"test httpold-4.5 {httpEvent} {    set testfile [makeFile "" testfile]    set out [open $testfile w]    set token [http_get $url -channel $out]    close $out    upvar #0 $token data    removeFile $testfile    expr $data(currentsize) == $data(totalsize)} 1test httpold-4.6 {httpEvent} {    set testfile [makeFile "" testfile]    set out [open $testfile w]    set token [http_get $binurl -channel $out]    close $out    set in [open $testfile]    fconfigure $in -translation binary    set x [read $in]    close $in    removeFile $testfile    set x} "$bindata$binurl"proc myProgress {token total current} {    global progress httpLog    if {[info exists httpLog] && $httpLog} {	puts "progress $total $current"    }    set progress [list $total $current]}if 0 {    # This test hangs on Windows95 because the client never gets EOF    set httpLog 1    test httpold-4.6 {httpEvent} {	set token [http_get $url -blocksize 50 -progress myProgress]	set progress    } {111 111}}test httpold-4.7 {httpEvent} {    set token [http_get $url -progress myProgress]    set progress} {111 111}test httpold-4.8 {httpEvent} {    set token [http_get $url]    http_status $token} {ok}test httpold-4.9 {httpEvent} {    set token [http_get $url -progress myProgress]    http_code $token} {HTTP/1.0 200 Data follows}test httpold-4.10 {httpEvent} {    set token [http_get $url -progress myProgress]    http_size $token} {111}test httpold-4.11 {httpEvent} {    set token [http_get $url -timeout 1 -command {#}]    http_reset $token    http_status $token} {reset}test httpold-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 httpold-5.1 {http_formatQuery} {    http_formatQuery name1 value1 name2 "value two"} {name1=value1&name2=value+two}test httpold-5.2 {http_formatQuery} {    http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2} {name1=%7ebwelch&name2=%a1%a2%a2}test httpold-5.3 {http_formatQuery} {    http_formatQuery lines "line1\nline2\nline3"} {lines=line1%0d%0aline2%0d%0aline3}test httpold-6.1 {httpProxyRequired} {    update    http_config -proxyhost [info hostname] -proxyport $port    set token [http_get $url]    http_wait $token    http_config -proxyhost {} -proxyport {}    upvar #0 $token data    set data(body)} "<html><head><title>HTTP/1.0 TEST</title></head><body><h1>Hello, World!</h1><h2>GET http://$url</h2></body></html>"# cleanupcatch {unset url}catch {unset port}catch {unset data}close $listen::tcltest::cleanupTestsreturn
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -