merged tcl 8.1 branch back into the main trunk

1 files changed, 319 insertions, 5 deletions

diff --git a/tests/while.test b/tests/while.test
index cd9381f..f4c7581 100644
--- a/tests/while.test
+++ b/tests/while.test
@@ -5,13 +5,16 @@
 # 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.
 #
-# RCS: @(#) $Id: while.test,v 1.2 1998/09/14 18:40:15 stanton Exp $
+# RCS: @(#) $Id: while.test,v 1.3 1999/04/16 00:47:36 stanton Exp $
 
-if {[string compare test [info procs test]] == 1} then {source defs}
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
 
 # Basic "while" operation.
 
@@ -24,12 +27,12 @@ test while-1.1 {TclCompileWhileCmd: missing test expression} {
 } {wrong # args: should be "while test command"}
 test while-1.2 {TclCompileWhileCmd: error in test expression} {
     set i 0
-    catch {while {$i<}} msg
+    catch {while {$i<} break} msg
     set errorInfo
 } {syntax error in expression "$i<"
     ("while" test expression)
     while compiling
-"while {$i<}"}
+"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
@@ -286,7 +289,7 @@ test while-3.3 {break tests, long command body} {
     set a
 } {1 3}
 
-# Check "while", "break", "continue" and computed command names.
+# Check "while" with computed command names.
 
 test while-4.1 {while and computed command names} {
     set i 0
@@ -296,6 +299,149 @@ test while-4.1 {while and computed command names} {
     }
     set i
 } 10
+test while-4.2 {while (not compiled): missing test expression} {
+    set z while
+    catch {$z } msg
+    set msg
+} {wrong # args: should be "while test command"}
+test while-4.3 {while (not compiled): error in test expression} {
+    set i 0
+    set z while
+    catch {$z {$i<} {set x 1}} msg
+    set errorInfo
+} {syntax error in expression "$i<"
+    while executing
+"$z {$i<} {set x 1}"}
+test while-4.4 {while (not compiled): error in test expression} {
+    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} {
+    set value 1
+    set z while
+    $z {($tcl_platform(platform) != "foobar1") && \
+	    ($tcl_platform(platform) != "foobar2")} {
+        incr value
+        break
+    }
+    set value
+} {2}
+test while-4.6 {while (not compiled): non-numeric boolean test expr} {
+    set value 1
+    set z while
+    $z {"true"} {
+	incr value;
+	if {$value > 5} {
+	    break;
+	}
+    }
+    set value
+} 6
+test while-4.7 {while (not compiled): test expr is enclosed in quotes} {
+    set i 0
+    set z while
+    $z "$i > 5" {}
+} {}
+test while-4.8 {while (not compiled): missing command body} {
+    set i 0
+    set z while
+    catch {$z {$i < 5} } msg
+    set msg
+} {wrong # args: should be "while test command"}
+test while-4.9 {while (not compiled): error compiling command body} {
+    set i 0
+    set z while
+    catch {$z {$i < 5} {set}} msg
+    set errorInfo
+} {wrong # args: should be "set varName ?newValue?"
+    while compiling
+"set"
+    ("while" body line 1)
+    invoked from within
+"$z {$i < 5} {set}"}
+test while-4.10 {while (not compiled): simple command body} {
+    set a {}
+    set i 1
+    set z while
+    $z {$i<6} {
+	if $i==4 break
+	set a [concat $a $i]
+        incr i
+    }
+    set a
+} {1 2 3}
+test while-4.11 {while (not compiled): command body in quotes} {
+    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
+    catch {unset x1}
+    catch {unset bb}
+    catch {unset x2}
+    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} {
+    set a {}
+    set z while
+    set i 1
+    $z {$i<6} {
+	if $i==4 break
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	set a [concat $a $i]
+        incr i
+    }
+    set a
+} {1 2 3}
+test while-4.14 {while (not compiled): while command result} {
+    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} {
+    set i 0
+    set z while
+    set a [$z {$i < 5} {if $i==3 break; incr i}]
+    set a
+} {}
+
+# Check "break" with computed command names.
 
 test while-5.1 {break and computed command names} {
     set i 0
@@ -306,6 +452,73 @@ test while-5.1 {break and computed command names} {
     }
     set i
 } 11
+test while-5.2 {break tests with computed command names} {
+    set a {}
+    set i 1
+    set z break
+    while {$i <= 4} {
+	if {$i == 3} $z
+	set a [concat $a $i]
+        incr i
+    }
+    set a
+} {1 2}
+test while-5.3 {break tests, nested loops with computed command names} {
+    set msg {}
+    set i 1
+    set z break
+    while {$i <= 4} {
+        set a 1
+	while {$a <= 2} {
+            if {$i>=2 && $a>=2} $z
+            set msg [concat $msg "$i.$a"]
+            incr a
+        }
+        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} {
+    set a {}
+    set i 1
+    set z break
+    while {$i<6} {
+	if $i==2 {incr i; continue}
+	if $i==5 $z
+	if $i>5 continue
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if $i==4 $z
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	set a [concat $a $i]
+        incr i
+    }
+    set a
+} {1 3}
+
+# Check "continue" with computed command names.
 
 test while-6.1 {continue and computed command names} {
     set i 0
@@ -317,3 +530,104 @@ test while-6.1 {continue and computed command names} {
     }
     set i
 } 10
+test while-6.2 {continue tests} {
+    set a {}
+    set i 1
+    set z continue
+    while {$i <= 4} {
+        incr i
+	if {$i == 3} $z
+	set a [concat $a $i]
+    }
+    set a
+} {2 4 5}
+test while-6.3 {continue tests with computed command names} {
+    set a {}
+    set i 1
+    set z continue
+    while {$i <= 4} {
+        incr i
+	if {$i != 2} $z
+	set a [concat $a $i]
+    }
+    set a
+} {2}
+test while-6.4 {continue tests, nested loops with computed command names} {
+    set msg {}
+    set i 1
+    set z continue
+    while {$i <= 4} {
+        incr i
+        set a 1
+	while {$a <= 2} {
+            incr a
+            if {$i>=3 && $a>=3} $z
+            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} {
+    set a {}
+    set i 1
+    set z continue
+    while {$i<6} {
+	if $i==2 {incr i; continue}
+	if $i==4 break
+	if $i>5 $z
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	if {$i>6 && $tcl_platform(machine)=="xxx"} {
+	    catch {set a $a} msg
+	    catch {incr i 5} msg
+	    catch {incr i -5} msg
+	}
+	set a [concat $a $i]
+        incr i
+    }
+    set a
+} {1 3}
+
+# Test for incorrect "double evaluation" semantics
+
+test while-7.1 {delayed substitution of body} {knownBug} {
+    set i 0
+    while {[incr i] < 10} "
+       set result $i
+    "
+    set result
+} {0}
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+
+
+
+
+
+
+
+
+
+
+