From fa6b7f2da5eb55b89dee6899b3421c3490bed77c Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Fri, 30 Oct 2009 16:28:02 +0000
Subject: More variable hygiene.

---
 tests/while.test | 375 +++++++++++++++++++++++++++++++++----------------------
 1 file changed, 229 insertions(+), 146 deletions(-)

diff --git a/tests/while.test b/tests/while.test
index 5aadd10..323e160 100644
--- a/tests/while.test
+++ b/tests/while.test
@@ -1,18 +1,18 @@
 # Commands covered:  while
 #
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands.  Sourcing this file into Tcl runs the tests and generates output
+# for errors.  No output means no errors were found.
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: while.test,v 1.13 2006/10/09 19:15:45 msofer Exp $
+# RCS: @(#) $Id: while.test,v 1.14 2009/10/30 16:28:02 dkf Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
@@ -22,29 +22,31 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 catch {unset i}
 catch {unset a}
 
-test while-1.1 {TclCompileWhileCmd: missing test expression} {
-    catch {while } msg
-    set msg
-} {wrong # args: should be "while test command"}
+test while-1.1 {TclCompileWhileCmd: missing test expression} -body {
+    while
+} -returnCodes error -result {wrong # args: should be "while test command"}
 test while-1.2 {TclCompileWhileCmd: error in test expression} -body {
     set i 0
-    catch {while {$i<} break} msg
-    set ::errorInfo
+    catch {while {$i<} break}
+    return $::errorInfo
+} -cleanup {
+    unset i
 } -match glob -result {*"while {$i<} break"}
-test while-1.3 {TclCompileWhileCmd: error in test expression} {
-    set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
-    list $err $msg
-} {1 {can't use non-numeric string as operand of "+"}}
-test while-1.4 {TclCompileWhileCmd: multiline test expr} {
+test while-1.3 {TclCompileWhileCmd: error in test expression} -body {
+    while {"a"+"b"} {error "loop aborted"}
+} -returnCodes error -result {can't use non-numeric string as operand of "+"}
+test while-1.4 {TclCompileWhileCmd: multiline test expr} -body {
     set value 1
     while {($tcl_platform(platform) != "foobar1") && \
 	    ($tcl_platform(platform) != "foobar2")} {
         incr value
         break
     }
-    set value
-} {2}
-test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {
+    return $value
+} -cleanup {
+    unset value
+} -result {2}
+test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} -body {
     set value 1
     while {"true"} {
 	incr value;
@@ -52,25 +54,28 @@ test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {
 	    break;
 	}
     }
-    set value
-} 6
+    return $value
+} -cleanup {
+    unset value
+} -result 6
 test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} {
     set i 0
     while "$i > 5" {}
 } {}
-test while-1.7 {TclCompileWhileCmd: missing command body} {
+test while-1.7 {TclCompileWhileCmd: missing command body} -body {
     set i 0
-    catch {while {$i < 5} } msg
-    set msg
-} {wrong # args: should be "while test command"}
+    while {$i < 5}
+} -returnCodes error -result {wrong # args: should be "while test command"}
 test while-1.8 {TclCompileWhileCmd: error compiling command body} -body {
     set i 0
-    catch {while {$i < 5} {set}} msg
-    set ::errorInfo
-} -match glob -result {wrong # args: should be "set varName ?newValue?"
+    catch {while {$i < 5} {set}}
+    return $::errorInfo
+} -match glob -cleanup {
+    unset i
+} -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
-test while-1.9 {TclCompileWhileCmd: simple command body} {
+test while-1.9 {TclCompileWhileCmd: simple command body} -body {
     set a {}
     set i 1
     while {$i<6} {
@@ -78,27 +83,34 @@ test while-1.9 {TclCompileWhileCmd: simple command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2 3}
-test while-1.10 {TclCompileWhileCmd: command body in quotes} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {1 2 3}
+test while-1.10 {TclCompileWhileCmd: command body in quotes} -body {
     set a {}
     set i 1
     while {$i<6} "append a x; incr i"
-    set a
-} {xxxxx}
-test while-1.11 {TclCompileWhileCmd: computed command body} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {xxxxx}
+test while-1.11 {TclCompileWhileCmd: computed command body} -setup {
     catch {unset x1}
     catch {unset bb}
     catch {unset x2}
+} -body {
     set x1 {append a x1; }
     set bb {break}
     set x2 {; append a x2; incr i}
     set a {}
     set i 1
     while {$i<6} $x1$bb$x2
-    set a
-} {x1}
-test while-1.12 {TclCompileWhileCmd: long command body} {
+    return $a
+} -cleanup {
+    unset x1 bb x2 a i
+} -result {x1}
+test while-1.12 {TclCompileWhileCmd: long command body} -body {
     set a {}
     set i 1
     while {$i<6} {
@@ -132,22 +144,28 @@ test while-1.12 {TclCompileWhileCmd: long command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2 3}
-test while-1.13 {TclCompileWhileCmd: while command result} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {1 2 3}
+test while-1.13 {TclCompileWhileCmd: while command result} -body {
     set i 0
     set a [while {$i < 5} {incr i}]
-    set a
-} {}
-test while-1.14 {TclCompileWhileCmd: while command result} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {}
+test while-1.14 {TclCompileWhileCmd: while command result} -body {
     set i 0
     set a [while {$i < 5} {if $i==3 break; incr i}]
-    set a
-} {}
+    return $a
+} -cleanup {
+    unset a i
+} -result {}
 
 # Check "while" and "continue".
 
-test while-2.1 {continue tests} {
+test while-2.1 {continue tests} -body {
     set a {}
     set i 1
     while {$i <= 4} {
@@ -155,9 +173,11 @@ test while-2.1 {continue tests} {
 	if {$i == 3} continue
 	set a [concat $a $i]
     }
-    set a
-} {2 4 5}
-test while-2.2 {continue tests} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {2 4 5}
+test while-2.2 {continue tests} -body {
     set a {}
     set i 1
     while {$i <= 4} {
@@ -165,9 +185,11 @@ test while-2.2 {continue tests} {
 	if {$i != 2} continue
 	set a [concat $a $i]
     }
-    set a
-} {2}
-test while-2.3 {continue tests, nested loops} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {2}
+test while-2.3 {continue tests, nested loops} -body {
     set msg {}
     set i 1
     while {$i <= 4} {
@@ -179,9 +201,11 @@ test while-2.3 {continue tests, nested loops} {
             set msg [concat $msg "$i.$a"]
         }
     }
-    set msg
-} {2.2 2.3 3.2 4.2 5.2}
-test while-2.4 {continue tests, long command body} {
+    return $msg
+} -cleanup {
+    unset a i msg
+} -result {2.2 2.3 3.2 4.2 5.2}
+test while-2.4 {continue tests, long command body} -body {
     set a {}
     set i 1
     while {$i<6} {
@@ -216,12 +240,14 @@ test while-2.4 {continue tests, long command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 3}
+    return $a
+} -cleanup {
+    unset a i
+} -result {1 3}
 
 # Check "while" and "break".
 
-test while-3.1 {break tests} {
+test while-3.1 {break tests} -body {
     set a {}
     set i 1
     while {$i <= 4} {
@@ -229,9 +255,11 @@ test while-3.1 {break tests} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2}
-test while-3.2 {break tests, nested loops} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {1 2}
+test while-3.2 {break tests, nested loops} -body {
     set msg {}
     set i 1
     while {$i <= 4} {
@@ -243,9 +271,11 @@ test while-3.2 {break tests, nested loops} {
         }
         incr i
     }
-    set msg
-} {1.1 1.2 2.1 3.1 4.1}
-test while-3.3 {break tests, long command body} {
+    return $msg
+} -cleanup {
+    unset a i msg
+} -result {1.1 1.2 2.1 3.1 4.1}
+test while-3.3 {break tests, long command body} -body {
     set a {}
     set i 1
     while {$i<6} {
@@ -281,36 +311,42 @@ test while-3.3 {break tests, long command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 3}
+    return $a
+} -cleanup {
+    unset a i
+} -result {1 3}
 
 # Check "while" with computed command names.
 
-test while-4.1 {while and computed command names} {
+test while-4.1 {while and computed command names} -body {
     set i 0
     set z while
     $z {$i < 10} {
         incr i
     }
-    set i
-} 10
-test while-4.2 {while (not compiled): missing test expression} {
+    return $i
+} -cleanup {
+    unset i z
+} -result 10
+test while-4.2 {while (not compiled): missing test expression} -body {
     set z while
-    catch {$z } msg
-    set msg
-} {wrong # args: should be "while test command"}
+    $z
+} -returnCodes error -cleanup {
+    unset z
+} -result {wrong # args: should be "while test command"}
 test while-4.3 {while (not compiled): error in test expression} -body {
     set i 0
     set z while
-    catch {$z {$i<} {set x 1}} msg
-    set ::errorInfo
-} -match glob -result {*"$z {$i<} {set x 1}"}
-test while-4.4 {while (not compiled): error in test expression} {
+    catch {$z {$i<} {set x 1}}
+    return $::errorInfo
+} -match glob -cleanup {
+    unset i z
+} -result {*"$z {$i<} {set x 1}"}
+test while-4.4 {while (not compiled): error in test expression} -body {
     set z while
-    set err [catch {$z {"a"+"b"} {error "loop aborted"}} msg]
-    list $err $msg
-} {1 {can't use non-numeric string as operand of "+"}}
-test while-4.5 {while (not compiled): multiline test expr} {
+    $z {"a"+"b"} {error "loop aborted"}
+} -returnCodes error -result {can't use non-numeric string as operand of "+"}
+test while-4.5 {while (not compiled): multiline test expr} -body {
     set value 1
     set z while
     $z {($tcl_platform(platform) != "foobar1") && \
@@ -318,9 +354,11 @@ test while-4.5 {while (not compiled): multiline test expr} {
         incr value
         break
     }
-    set value
-} {2}
-test while-4.6 {while (not compiled): non-numeric boolean test expr} {
+    return $value
+} -cleanup {
+    unset value z
+} -result {2}
+test while-4.6 {while (not compiled): non-numeric boolean test expr} -body {
     set value 1
     set z while
     $z {"true"} {
@@ -329,31 +367,38 @@ test while-4.6 {while (not compiled): non-numeric boolean test expr} {
 	    break;
 	}
     }
-    set value
-} 6
-test while-4.7 {while (not compiled): test expr is enclosed in quotes} {
+    return $value
+} -cleanup {
+    unset value z
+} -result 6
+test while-4.7 {while (not compiled): test expr is enclosed in quotes} -body {
     set i 0
     set z while
     $z "$i > 5" {}
-} {}
-test while-4.8 {while (not compiled): missing command body} {
+} -cleanup {
+    unset i z
+} -result {}
+test while-4.8 {while (not compiled): missing command body} -body {
     set i 0
     set z while
-    catch {$z {$i < 5} } msg
-    set msg
-} {wrong # args: should be "while test command"}
+    $z {$i < 5}
+} -returnCodes error -cleanup {
+    unset i z
+} -result {wrong # args: should be "while test command"}
 test while-4.9 {while (not compiled): error compiling command body} -body {
     set i 0
     set z while
-    catch {$z {$i < 5} {set}} msg
+    catch {$z {$i < 5} {set}}
     set ::errorInfo
-} -match glob -result {wrong # args: should be "set varName ?newValue?"
+} -match glob -cleanup {
+    unset i z
+} -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"
     ("while" body line 1)
     invoked from within
 "$z {$i < 5} {set}"}
-test while-4.10 {while (not compiled): simple command body} {
+test while-4.10 {while (not compiled): simple command body} -body {
     set a {}
     set i 1
     set z while
@@ -362,29 +407,36 @@ test while-4.10 {while (not compiled): simple command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2 3}
-test while-4.11 {while (not compiled): command body in quotes} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {1 2 3}
+test while-4.11 {while (not compiled): command body in quotes} -body {
     set a {}
     set i 1
     set z while
     $z {$i<6} "append a x; incr i"
-    set a
-} {xxxxx}
-test while-4.12 {while (not compiled): computed command body} {
-    set z while
+    return $a
+} -cleanup {
+    unset a i z
+} -result {xxxxx}
+test while-4.12 {while (not compiled): computed command body} -setup {
     catch {unset x1}
     catch {unset bb}
     catch {unset x2}
+} -body {
+    set z while
     set x1 {append a x1; }
     set bb {break}
     set x2 {; append a x2; incr i}
     set a {}
     set i 1
     $z {$i<6} $x1$bb$x2
-    set a
-} {x1}
-test while-4.13 {while (not compiled): long command body} {
+    return $a
+} -cleanup {
+    unset z x1 bb x2 a i
+} -result {x1}
+test while-4.13 {while (not compiled): long command body} -body {
     set a {}
     set z while
     set i 1
@@ -419,33 +471,41 @@ test while-4.13 {while (not compiled): long command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2 3}
-test while-4.14 {while (not compiled): while command result} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {1 2 3}
+test while-4.14 {while (not compiled): while command result} -body {
     set i 0
     set z while
     set a [$z {$i < 5} {incr i}]
-    set a
-} {}
-test while-4.15 {while (not compiled): while command result} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {}
+test while-4.15 {while (not compiled): while command result} -body {
     set i 0
     set z while
     set a [$z {$i < 5} {if $i==3 break; incr i}]
-    set a
-} {}
+    return $a
+} -cleanup {
+    unset a i z
+} -result {}
 
 # Check "break" with computed command names.
 
-test while-5.1 {break and computed command names} {
+test while-5.1 {break and computed command names} -body {
     set i 0
     set z break
     while 1 {
         if {$i > 10} $z
         incr i
     }
-    set i
-} 11
-test while-5.2 {break tests with computed command names} {
+    return $i
+} -cleanup {
+    unset i z
+} -result 11
+test while-5.2 {break tests with computed command names} -body {
     set a {}
     set i 1
     set z break
@@ -454,9 +514,11 @@ test while-5.2 {break tests with computed command names} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2}
-test while-5.3 {break tests, nested loops with computed command names} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {1 2}
+test while-5.3 {break tests, nested loops with computed command names} -body {
     set msg {}
     set i 1
     set z break
@@ -469,9 +531,11 @@ test while-5.3 {break tests, nested loops with computed command names} {
         }
         incr i
     }
-    set msg
-} {1.1 1.2 2.1 3.1 4.1}
-test while-5.4 {break tests, long command body with computed command names} {
+    return $msg
+} -cleanup {
+    unset a i z msg
+} -result {1.1 1.2 2.1 3.1 4.1}
+test while-5.4 {break tests, long command body with computed command names} -body {
     set a {}
     set i 1
     set z break
@@ -508,12 +572,14 @@ test while-5.4 {break tests, long command body with computed command names} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 3}
+    return $a
+} -cleanup {
+    unset a i z
+} -result {1 3}
 
 # Check "continue" with computed command names.
 
-test while-6.1 {continue and computed command names} {
+test while-6.1 {continue and computed command names} -body {
     set i 0
     set z continue
     while 1 {
@@ -521,9 +587,11 @@ test while-6.1 {continue and computed command names} {
         if {$i < 10} $z
         break
     }
-    set i
-} 10
-test while-6.2 {continue tests} {
+    return $i
+} -cleanup {
+    unset i z
+} -result 10
+test while-6.2 {continue tests} -body {
     set a {}
     set i 1
     set z continue
@@ -532,9 +600,11 @@ test while-6.2 {continue tests} {
 	if {$i == 3} $z
 	set a [concat $a $i]
     }
-    set a
-} {2 4 5}
-test while-6.3 {continue tests with computed command names} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {2 4 5}
+test while-6.3 {continue tests with computed command names} -body {
     set a {}
     set i 1
     set z continue
@@ -543,9 +613,11 @@ test while-6.3 {continue tests with computed command names} {
 	if {$i != 2} $z
 	set a [concat $a $i]
     }
-    set a
-} {2}
-test while-6.4 {continue tests, nested loops with computed command names} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {2}
+test while-6.4 {continue tests, nested loops with computed command names} -body {
     set msg {}
     set i 1
     set z continue
@@ -558,9 +630,11 @@ test while-6.4 {continue tests, nested loops with computed command names} {
             set msg [concat $msg "$i.$a"]
         }
     }
-    set msg
-} {2.2 2.3 3.2 4.2 5.2}
-test while-6.5 {continue tests, long command body with computed command names} {
+    return $msg
+} -cleanup {
+    unset a i z msg
+} -result {2.2 2.3 3.2 4.2 5.2}
+test while-6.5 {continue tests, long command body with computed command names} -body {
     set a {}
     set i 1
     set z continue
@@ -596,12 +670,14 @@ test while-6.5 {continue tests, long command body with computed command names} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 3}
+    return $a
+} -cleanup {
+    unset a i z
+} -result {1 3}
 
 # Test for incorrect "double evaluation" semantics
 
-test while-7.1 {delayed substitution of body} {
+test while-7.1 {delayed substitution of body} -body {
     set i 0
     while {[incr i] < 10} "
        set result $i
@@ -611,11 +687,18 @@ test while-7.1 {delayed substitution of body} {
 	while {[incr i] < 10} "
 	    set result $i
 	"
-	set result
+	return $result
     }
     append result [p]
-} {00}
+} -cleanup {
+    unset result i
+} -result {00}
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
-- 
cgit v0.12