From f17e0dcfad73ba08f3b53d2b51bb1b729c4731cf Mon Sep 17 00:00:00 2001
From: aniap <aniap>
Date: Tue, 22 Jul 2008 11:39:08 +0000
Subject: Update to tcltest2

---
 tests/bell.test    | 59 ++++++++++++++++++++++++++++++------------------------
 tests/bgerror.test | 47 +++++++++++++++++++++++++------------------
 2 files changed, 61 insertions(+), 45 deletions(-)

diff --git a/tests/bell.test b/tests/bell.test
index 455eb76..b110619 100644
--- a/tests/bell.test
+++ b/tests/bell.test
@@ -5,34 +5,42 @@
 # Copyright (c) 1998-2000 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: bell.test,v 1.8 2004/05/23 17:34:48 dkf Exp $
+# RCS: @(#) $Id: bell.test,v 1.9 2008/07/22 11:39:08 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
-test bell-1.1 {bell command} {
-    list [catch {bell a} msg] $msg
-} {1 {bad option "a": must be -displayof or -nice}}
-test bell-1.2 {bell command} {
-    list [catch {bell a b} msg] $msg
-} {1 {bad option "a": must be -displayof or -nice}}
-test bell-1.3 {bell command} {
-    list [catch {bell -displayof gorp} msg] $msg
-} {1 {bad window path name "gorp"}}
-test bell-1.4 {bell command} {
-    list [catch {bell -nice -displayof} msg] $msg
-} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}}
-test bell-1.5 {bell command} {
-    list [catch {bell -nice -nice -nice} msg] $msg
-} {0 {}}
-test bell-1.6 {bell command} {
-    list [catch {bell -displayof . -nice} msg] $msg
-} {0 {}}
-test bell-1.7 {bell command} {
-    list [catch {bell -nice -displayof . -nice} msg] $msg
-} {1 {wrong # args: should be "bell ?-displayof window? ?-nice?"}}
-test bell-1.8 {bell command} {
+test bell-1.1 {bell command} -body {
+    bell a
+} -returnCodes {error} -result {bad option "a": must be -displayof or -nice}
+
+test bell-1.2 {bell command} -body {
+    bell a b 
+} -returnCodes {error} -result {bad option "a": must be -displayof or -nice}
+
+test bell-1.3 {bell command} -body {
+    bell -displayof gorp
+} -returnCodes {error} -result {bad window path name "gorp"}
+
+test bell-1.4 {bell command} -body {
+    bell -nice -displayof
+} -returnCodes {error} -result {wrong # args: should be "bell ?-displayof window? ?-nice?"}
+
+test bell-1.5 {bell command} -body {
+    bell -nice -nice -nice
+} -returnCodes {ok} -result {}  ;#keep -result {} and -retutnCodes {ok} for clarity?
+
+test bell-1.6 {bell command} -body {
+    bell -displayof . -nice
+} -returnCodes {ok} -result {}
+
+test bell-1.7 {bell command} -body {
+    bell -nice -displayof . -nice
+} -returnCodes {error} -result {wrong # args: should be "bell ?-displayof window? ?-nice?"}
+
+test bell-1.8 {bell command} -body {
     puts "Bell should ring now ..."
     flush stdout
     after 200
@@ -41,8 +49,7 @@ test bell-1.8 {bell command} {
     bell -nice
     after 200
     bell
-} {}
+} -result {}
 
-# cleanup
 cleanupTests
 return
diff --git a/tests/bgerror.test b/tests/bgerror.test
index 7d35862..6148c71 100644
--- a/tests/bgerror.test
+++ b/tests/bgerror.test
@@ -5,51 +5,60 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: bgerror.test,v 1.6 2004/05/23 17:34:48 dkf Exp $
+# RCS: @(#) $Id: bgerror.test,v 1.7 2008/07/22 11:48:24 aniap Exp $
 
-package require tcltest 2.1
+package require tcltest 2.2
+namespace import ::tcltest::*
 eval tcltest::configure $argv
 tcltest::loadTestedCommands
 
-test bgerror-1.1 {bgerror / tkerror compat} {
+test bgerror-1.1 {bgerror / tkerror compat} -setup {
     set errRes {}
     proc tkerror {err} {
-	global errRes;
-	set errRes $err;
+        global errRes;
+        set errRes $err;
     }
+} -body {
     after 0 {error err1}
     vwait errRes;
-    set errRes;
-} err1
+    return $errRes;
+} -cleanup {
+    catch {rename tkerror {}}
+} -result {err1}
 
-test bgerror-1.2 {bgerror / tkerror compat / accumulation} {
+test bgerror-1.2 {bgerror / tkerror compat / accumulation} -setup {
     set errRes {}
     proc tkerror {err} {
-	global errRes;
-	lappend errRes $err;
+        global errRes;
+        lappend errRes $err;
     }
+} -body {
     after 0 {error err1}
     after 0 {error err2}
     after 0 {error err3}
     update
-    set errRes;
-} {err1 err2 err3}
+    return $errRes;
+} -cleanup {
+    catch {rename tkerror {}}
+} -result {err1 err2 err3}
 
-test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} {
+test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} -setup {
     set errRes {}
     proc tkerror {err} {
-	global errRes;
-	lappend errRes $err;
-	return -code break "skip!";
+        global errRes;
+        lappend errRes $err;
+        return -code break "skip!";
     }
+} -body {
     after 0 {error err1}
     after 0 {error err2}
     after 0 {error err3}
     update
-    set errRes;
-} err1
+    return $errRes;
+} -cleanup {
+    catch {rename tkerror {}}
+} -result {err1}
 
-catch {rename tkerror {}}
 
 # some testing of the default error dialog
 # would be needed too, but that's not easy at all
-- 
cgit v0.12