Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/tests/httpold.test @ 45

Last change on this file since 45 was 25, checked in by landauf, 18 years ago

added tcl to libs
File size: 7.7 KB
RevLine 
[25]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.12 2004/05/19 12:44:27 dkf Exp $
15
16if {[lsearch [namespace children] ::tcltest] == -1} {
17    package require tcltest
18    namespace import -force ::tcltest::*
19}
20
21if {[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}
37
38set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
39catch {unset data}
40
41##
42## The httpd script implement a stub http server
43##
44source [file join [file dirname [info script]] httpd]
45
46set port 8010
47if [catch {httpd_init $port} listen] {
48    puts "Cannot start http server, http test skipped"
49    unset port
50    ::tcltest::cleanupTests
51    return
52}
53
54test httpold-1.1 {http_config} {
55    http_config
56} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
57
58test httpold-1.2 {http_config} {
59    http_config -proxyfilter
60} httpProxyRequired
61
62test httpold-1.3 {http_config} {
63    catch {http_config -junk}
64} 1
65
66test 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}}
73
74test httpold-1.5 {http_config} {
75    catch {http_config -proxyhost {} -junk 8080}
76} 1
77
78test httpold-2.1 {http_reset} {
79    catch {http_reset http#1}
80} 0
81
82test httpold-3.1 {http_get} {
83    catch {http_get -bogus flag}
84} 1
85test httpold-3.2 {http_get} {
86    catch {http_get http:junk} err
87    set err
88} {Unsupported URL: http:junk}
89
90set url [info hostname]:$port
91test 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>"
98
99set tail /a/b/c
100set url [info hostname]:$port/a/b/c
101set binurl [info hostname]:$port/binary
102
103test 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>"
110
111proc selfproxy {host} {
112    global port
113    return [list [info hostname] $port]
114}
115test 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>"
124
125test 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>"
134
135test 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>"
142
143test 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>"
155
156test httpold-3.9 {http_get} {
157    set token [http_get $url -validate 1]
158    http_code $token
159} "HTTP/1.0 200 OK"
160
161
162test 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
168
169test 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
175
176test httpold-4.3 {httpEvent} {
177    set token [http_get $url]
178    http_code $token
179} {HTTP/1.0 200 Data follows}
180
181test 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>"
195
196test 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
205
206test 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"
218
219proc 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}
226if 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}
234test httpold-4.7 {httpEvent} {
235    set token [http_get $url -progress myProgress]
236    set progress
237} {111 111}
238test httpold-4.8 {httpEvent} {
239    set token [http_get $url]
240    http_status $token
241} {ok}
242test httpold-4.9 {httpEvent} {
243    set token [http_get $url -progress myProgress]
244    http_code $token
245} {HTTP/1.0 200 Data follows}
246test httpold-4.10 {httpEvent} {
247    set token [http_get $url -progress myProgress]
248    http_size $token
249} {111}
250test httpold-4.11 {httpEvent} {
251    set token [http_get $url -timeout 1 -command {#}]
252    http_reset $token
253    http_status $token
254} {reset}
255test 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}
263
264test httpold-5.1 {http_formatQuery} {
265    http_formatQuery name1 value1 name2 "value two"
266} {name1=value1&name2=value+two}
267
268test httpold-5.2 {http_formatQuery} {
269    http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
270} {name1=%7ebwelch&name2=%a1%a2%a2}
271
272test httpold-5.3 {http_formatQuery} {
273    http_formatQuery lines "line1\nline2\nline3"
274} {lines=line1%0d%0aline2%0d%0aline3}
275
276test 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>"
288
289# cleanup
290catch {unset url}
291catch {unset port}
292catch {unset data}
293close $listen
294::tcltest::cleanupTests
295return
Note: See TracBrowser for help on using the repository browser.