Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/httpold.test@bde4ae8d615e

     1 # Commands covered:  http_config, http_get, http_wait, http_reset

2 #

     3 # This file contains a collection of tests for the http script library.

     4 # Sourcing this file into Tcl runs the tests and

     5 # generates output for errors.  No output means no errors were found.

6 #

     7 # Copyright (c) 1991-1993 The Regents of the University of California.

     8 # Copyright (c) 1994-1996 Sun Microsystems, Inc.

     9 # Copyright (c) 1998-1999 by Scriptics Corporation.

    10 #

    11 # See the file "license.terms" for information on usage and redistribution

    12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.

    13 #

    14 # RCS: @(#) $Id: httpold.test,v 1.11 2002/10/03 13:34:32 dkf Exp $

    16 if {[lsearch [namespace children] ::tcltest] == -1} {

    17     package require tcltest

    18     namespace import -force ::tcltest::*

    19 }

    21 if {[catch {package require http 1.0}]} {

    22     if {[info exists httpold]} {

    23 	catch {puts "Cannot load http 1.0 package"}

    24 	::tcltest::cleanupTests

    25 	return

    26     } else {

    27 	catch {puts "Running http 1.0 tests in slave interp"}

    28 	set interp [interp create httpold]

    29 	$interp eval [list set httpold "running"]

    30 	$interp eval [list set argv $argv]

    31 	$interp eval [list source [info script]]

    32 	interp delete $interp

    33 	::tcltest::cleanupTests

    34 	return

    35     }

    36 }

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

    39 catch {unset data}

    41 ##

    42 ## The httpd script implement a stub http server

    43 ##

    44 source [file join [file dirname [info script]] httpd]

    46 set port 8010

    47 if [catch {httpd_init $port} listen] {

    48     puts "Cannot start http server, http test skipped"

    49     unset port

    50     ::tcltest::cleanupTests

    51     return

    52 }

    54 test httpold-1.1 {http_config} {

    55     http_config

    56 } {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}

    58 test httpold-1.2 {http_config} {

    59     http_config -proxyfilter

    60 } httpProxyRequired

    62 test httpold-1.3 {http_config} {

    63     catch {http_config -junk}

    64 } 1

    66 test httpold-1.4 {http_config} {

    67     http_config -proxyhost nowhere.come -proxyport 8080 -proxyfilter myFilter -useragent "Tcl Test Suite"

    68     set x [http_config]

    69     http_config -proxyhost {} -proxyport {} -proxyfilter httpProxyRequired \

    70 	-useragent "Tcl http client package 1.0"

    71     set x

    72 } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}

    74 test httpold-1.5 {http_config} {

    75     catch {http_config -proxyhost {} -junk 8080}

    76 } 1

    78 test httpold-2.1 {http_reset} {

    79     catch {http_reset http#1}

    80 } 0

    82 test httpold-3.1 {http_get} {

    83     catch {http_get -bogus flag}

    84 } 1

    85 test httpold-3.2 {http_get} {

    86     catch {http_get http:junk} err

    87     set err

    88 } {Unsupported URL: http:junk}

    90 set url [info hostname]:$port

    91 test httpold-3.3 {http_get} {

    92     set token [http_get $url]

    93     http_data $token

    94 } "<html><head><title>HTTP/1.0 TEST</title></head><body>

    95 <h1>Hello, World!</h1>

    96 <h2>GET /</h2>

    97 </body></html>"

    99 set tail /a/b/c

   100 set url [info hostname]:$port/a/b/c

   101 set binurl [info hostname]:$port/binary

   103 test httpold-3.4 {http_get} {

   104     set token [http_get $url]

   105     http_data $token

   106 } "<html><head><title>HTTP/1.0 TEST</title></head><body>

   107 <h1>Hello, World!</h1>

   108 <h2>GET $tail</h2>

   109 </body></html>"

   111 proc selfproxy {host} {

   112     global port

   113     return [list [info hostname] $port]

   114 }

   115 test httpold-3.5 {http_get} {

   116     http_config -proxyfilter selfproxy

   117     set token [http_get $url]

   118     http_config -proxyfilter httpProxyRequired

   119     http_data $token

   120 } "<html><head><title>HTTP/1.0 TEST</title></head><body>

   121 <h1>Hello, World!</h1>

   122 <h2>GET http://$url</h2>

   123 </body></html>"

   125 test httpold-3.6 {http_get} {

   126     http_config -proxyfilter bogus

   127     set token [http_get $url]

   128     http_config -proxyfilter httpProxyRequired

   129     http_data $token

   130 } "<html><head><title>HTTP/1.0 TEST</title></head><body>

   131 <h1>Hello, World!</h1>

   132 <h2>GET $tail</h2>

   133 </body></html>"

   135 test httpold-3.7 {http_get} {

   136     set token [http_get $url -headers {Pragma no-cache}]

   137     http_data $token

   138 } "<html><head><title>HTTP/1.0 TEST</title></head><body>

   139 <h1>Hello, World!</h1>

   140 <h2>GET $tail</h2>

   141 </body></html>"

   143 test httpold-3.8 {http_get} {

   144     set token [http_get $url -query Name=Value&Foo=Bar]

   145     http_data $token

   146 } "<html><head><title>HTTP/1.0 TEST</title></head><body>

   147 <h1>Hello, World!</h1>

   148 <h2>POST $tail</h2>

   149 <h2>Query</h2>

   150 <dl>

   151 <dt>Name<dd>Value

   152 <dt>Foo<dd>Bar

   153 </dl>

   154 </body></html>"

   156 test httpold-3.9 {http_get} {

   157     set token [http_get $url -validate 1]

   158     http_code $token

   159 } "HTTP/1.0 200 OK"

   162 test httpold-4.1 {httpEvent} {

   163     set token [http_get $url]

   164     upvar #0 $token data

   165     array set meta $data(meta)

   166     expr ($data(totalsize) == $meta(Content-Length))

   167 } 1

   169 test httpold-4.2 {httpEvent} {

   170     set token [http_get $url]

   171     upvar #0 $token data

   172     array set meta $data(meta)

   173     string compare $data(type) [string trim $meta(Content-Type)]

   174 } 0

   176 test httpold-4.3 {httpEvent} {

   177     set token [http_get $url]

   178     http_code $token

   179 } {HTTP/1.0 200 Data follows}

   181 test httpold-4.4 {httpEvent} {

   182     set testfile [makeFile "" testfile]

   183     set out [open $testfile w]

   184     set token [http_get $url -channel $out]

   185     close $out

   186     set in [open $testfile]

   187     set x [read $in]

   188     close $in

   189     removeFile $testfile

   190     set x

   191 } "<html><head><title>HTTP/1.0 TEST</title></head><body>

   192 <h1>Hello, World!</h1>

   193 <h2>GET $tail</h2>

   194 </body></html>"

   196 test httpold-4.5 {httpEvent} {

   197     set testfile [makeFile "" testfile]

   198     set out [open $testfile w]

   199     set token [http_get $url -channel $out]

   200     close $out

   201     upvar #0 $token data

   202     removeFile $testfile

   203     expr $data(currentsize) == $data(totalsize)

   204 } 1

   206 test httpold-4.6 {httpEvent} {

   207     set testfile [makeFile "" testfile]

   208     set out [open $testfile w]

   209     set token [http_get $binurl -channel $out]

   210     close $out

   211     set in [open $testfile]

   212     fconfigure $in -translation binary

   213     set x [read $in]

   214     close $in

   215     removeFile $testfile

   216     set x

   217 } "$bindata$binurl"

   219 proc myProgress {token total current} {

   220     global progress httpLog

   221     if {[info exists httpLog] && $httpLog} {

   222 	puts "progress $total $current"

   223     }

   224     set progress [list $total $current]

   225 }

   226 if 0 {

   227     # This test hangs on Windows95 because the client never gets EOF

   228     set httpLog 1

   229     test httpold-4.6 {httpEvent} {

   230 	set token [http_get $url -blocksize 50 -progress myProgress]

   231 	set progress

   232     } {111 111}

   233 }

   234 test httpold-4.7 {httpEvent} {

   235     set token [http_get $url -progress myProgress]

   236     set progress

   237 } {111 111}

   238 test httpold-4.8 {httpEvent} {

   239     set token [http_get $url]

   240     http_status $token

   241 } {ok}

   242 test httpold-4.9 {httpEvent} {

   243     set token [http_get $url -progress myProgress]

   244     http_code $token

   245 } {HTTP/1.0 200 Data follows}

   246 test httpold-4.10 {httpEvent} {

   247     set token [http_get $url -progress myProgress]

   248     http_size $token

   249 } {111}

   250 test httpold-4.11 {httpEvent} {

   251     set token [http_get $url -timeout 1 -command {#}]

   252     http_reset $token

   253     http_status $token

   254 } {reset}

   255 test httpold-4.12 {httpEvent} {

   256     update

   257     set x {}

   258     after 500 {lappend x ok}

   259     set token [http_get $url -timeout 1 -command {lappend x fail}]

   260     vwait x

   261     list [http_status $token] $x

   262 } {timeout ok}

   264 test httpold-5.1 {http_formatQuery} {

   265     http_formatQuery name1 value1 name2 "value two"

   266 } {name1=value1&name2=value+two}

   268 test httpold-5.2 {http_formatQuery} {

   269     http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2

   270 } {name1=%7ebwelch&name2=%a1%a2%a2}

   272 test httpold-5.3 {http_formatQuery} {

   273     http_formatQuery lines "line1\nline2\nline3"

   274 } {lines=line1%0d%0aline2%0d%0aline3}

   276 test httpold-6.1 {httpProxyRequired} {

   277     update

   278     http_config -proxyhost [info hostname] -proxyport $port

   279     set token [http_get $url]

   280     http_wait $token

   281     http_config -proxyhost {} -proxyport {}

   282     upvar #0 $token data

   283     set data(body)

   284 } "<html><head><title>HTTP/1.0 TEST</title></head><body>

   285 <h1>Hello, World!</h1>

   286 <h2>GET http://$url</h2>

   287 </body></html>"

   289 # cleanup

   290 catch {unset url}

   291 catch {unset port}

   292 catch {unset data}

   293 close $listen

   294 ::tcltest::cleanupTests

   295 return

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--