new subtree for tcl/tk

1 files changed, 0 insertions, 702 deletions

diff --git a/tcl8.6/tests/while.test b/tcl8.6/tests/while.test
deleted file mode 100644
index 642ec93..0000000
--- a/tcl8.6/tests/while.test
+++ /dev/null
@@ -1,702 +0,0 @@
-# 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.
-#
-# 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.
-
-if {"::tcltest" ni [namespace children]} {
-    package require tcltest 2
-    namespace import -force ::tcltest::*
-}
-
-# Basic "while" operation.
-
-catch {unset i}
-catch {unset a}
-
-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}
-    return $::errorInfo
-} -cleanup {
-    unset i
-} -match glob -result {*"while {$i<} break"}
-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
-    }
-    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;
-	if {$value > 5} {
-	    break;
-	}
-    }
-    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} -body {
-    set i 0
-    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}}
-    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} -body {
-    set a {}
-    set i 1
-    while {$i<6} {
-	if $i==4 break
-	set a [concat $a $i]
-        incr i
-    }
-    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"
-    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
-    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} {
-	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
-    }
-    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}]
-    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}]
-    return $a
-} -cleanup {
-    unset a i
-} -result {}
-
-# Check "while" and "continue".
-
-test while-2.1 {continue tests} -body {
-    set a {}
-    set i 1
-    while {$i <= 4} {
-        incr i
-	if {$i == 3} continue
-	set a [concat $a $i]
-    }
-    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} {
-        incr i
-	if {$i != 2} continue
-	set a [concat $a $i]
-    }
-    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} {
-        incr i
-        set a 1
-	while {$a <= 2} {
-            incr a
-            if {$i>=3 && $a>=3} continue
-            set msg [concat $msg "$i.$a"]
-        }
-    }
-    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} {
-	if $i==2 {incr i; continue}
-	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
-    }
-    return $a
-} -cleanup {
-    unset a i
-} -result {1 3}
-
-# Check "while" and "break".
-
-test while-3.1 {break tests} -body {
-    set a {}
-    set i 1
-    while {$i <= 4} {
-	if {$i == 3} break
-	set a [concat $a $i]
-        incr i
-    }
-    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} {
-        set a 1
-	while {$a <= 2} {
-            if {$i>=2 && $a>=2} break
-            set msg [concat $msg "$i.$a"]
-            incr a
-        }
-        incr i
-    }
-    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} {
-	if $i==2 {incr i; continue}
-	if $i==5 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==4 break
-	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
-    }
-    return $a
-} -cleanup {
-    unset a i
-} -result {1 3}
-
-# Check "while" with computed command names.
-
-test while-4.1 {while and computed command names} -body {
-    set i 0
-    set z while
-    $z {$i < 10} {
-        incr i
-    }
-    return $i
-} -cleanup {
-    unset i z
-} -result 10
-test while-4.2 {while (not compiled): missing test expression} -body {
-    set z while
-    $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}}
-    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
-    $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") && \
-	    ($tcl_platform(platform) != "foobar2")} {
-        incr value
-        break
-    }
-    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"} {
-	incr value;
-	if {$value > 5} {
-	    break;
-	}
-    }
-    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" {}
-} -cleanup {
-    unset i z
-} -result {}
-test while-4.8 {while (not compiled): missing command body} -body {
-    set i 0
-    set z while
-    $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}}
-    set ::errorInfo
-} -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} -body {
-    set a {}
-    set i 1
-    set z while
-    $z {$i<6} {
-	if $i==4 break
-	set a [concat $a $i]
-        incr i
-    }
-    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"
-    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
-    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
-    $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
-    }
-    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}]
-    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}]
-    return $a
-} -cleanup {
-    unset a i z
-} -result {}
-
-# Check "break" with 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
-    }
-    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
-    while {$i <= 4} {
-	if {$i == 3} $z
-	set a [concat $a $i]
-        incr i
-    }
-    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
-    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
-    }
-    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
-    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
-    }
-    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} -body {
-    set i 0
-    set z continue
-    while 1 {
-        incr i
-        if {$i < 10} $z
-        break
-    }
-    return $i
-} -cleanup {
-    unset i z
-} -result 10
-test while-6.2 {continue tests} -body {
-    set a {}
-    set i 1
-    set z continue
-    while {$i <= 4} {
-        incr i
-	if {$i == 3} $z
-	set a [concat $a $i]
-    }
-    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
-    while {$i <= 4} {
-        incr i
-	if {$i != 2} $z
-	set a [concat $a $i]
-    }
-    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
-    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"]
-        }
-    }
-    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
-    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
-    }
-    return $a
-} -cleanup {
-    unset a i z
-} -result {1 3}
-
-# Test for incorrect "double evaluation" semantics
-
-test while-7.1 {delayed substitution of body} -body {
-    set i 0
-    while {[incr i] < 10} "
-       set result $i
-    "
-    proc p {} {
-	set i 0
-	while {[incr i] < 10} "
-	    set result $i
-	"
-	return $result
-    }
-    append result [p]
-} -cleanup {
-    unset result i
-} -result {00}
-
-# cleanup
-::tcltest::cleanupTests
-return
-
-# Local Variables:
-# mode: tcl
-# fill-column: 78
-# End: