From a7eab25d59444b0aa9cce14d593da3f2bb42eddf Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 13 Nov 2007 14:21:17 +0000
Subject: Make some tests clearer on failure by using tcltest2 features

---
 tests/http.test | 38 ++++++++++++++++----------------------
 1 file 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"
-- 
cgit v0.12