diff options
author | dkf <dkf@noemail.net> | 2007-11-13 14:21:17 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2007-11-13 14:21:17 (GMT) |
commit | d73d8d724ddeccc22d545d20183bc987bdaafce8 (patch) | |
tree | b8991a988f53bb5841f3da633cea0bcad0ceeab7 /tests | |
parent | 74b5bf77b05480dadf758bdea70983e8f9604edd (diff) | |
download | tcl-d73d8d724ddeccc22d545d20183bc987bdaafce8.zip tcl-d73d8d724ddeccc22d545d20183bc987bdaafce8.tar.gz tcl-d73d8d724ddeccc22d545d20183bc987bdaafce8.tar.bz2 |
Make some tests clearer on failure by using tcltest2 features
FossilOrigin-Name: 142ca82616b958c8c707b40e413a7b3dce4b2121
Diffstat (limited to 'tests')
-rw-r--r-- | tests/http.test | 38 |
1 files changed, 16 insertions, 22 deletions
diff --git a/tests/http.test b/tests/http.test index e5aaa19..e1afcd0 100644 --- a/tests/http.test +++ b/tests/http.test @@ -12,7 +12,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # -# RCS: @(#) $Id: http.test,v 1.44 2006/11/03 00:34:52 hobbs Exp $ +# RCS: @(#) $Id: http.test,v 1.45 2007/11/13 14:21:17 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -436,30 +436,24 @@ test http-4.13 {http::Event} { } {timeout} # Longer timeout to good host, bad port, gets an error after the # connection "completes" but the socket is bad. -test http-4.14 {http::Event} { - set code [catch { - set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}] - if {[string length $token] == 0} { - error "bogus return from http::geturl" - } - http::wait $token - http::status $token - } err] +test http-4.14 {http::Event} -body { + set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#] + if {$token eq ""} { + error "bogus return from http::geturl" + } + http::wait $token + http::status $token # error code varies among platforms. - list $code [regexp {(connect failed|couldn't open socket)} $err] -} {1 1} +} -returnCodes 1 -match regexp -result {(connect failed|couldn't open socket)} # Bogus host -test http-4.15 {http::Event} { - # This test may fail if you use a proxy server. That is to be +test http-4.15 {http::Event} -body { + # This test may fail if you use a proxy server. That is to be # expected and is not a problem with Tcl. - set code [catch { - set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command {#}] - http::wait $token - http::status $token - } err] - # error code varies among platforms. - list $code [string match "couldn't open socket*" $err] -} {1 1} + set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command \#] + http::wait $token + http::status $token + # error codes vary among platforms. +} -returnCodes 1 -match glob -result "couldn't open socket*" test http-5.1 {http::formatQuery} { http::formatQuery name1 value1 name2 "value two" |