diff -r 000000000000 -r bde4ae8d615e os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/switch.test
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/switch.test	Fri Jun 15 03:10:57 2012 +0200
@@ -0,0 +1,218 @@
+# Commands covered:  switch
+#
+# 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) 1993 The Regents of the University of California.
+# Copyright (c) 1994 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: switch.test,v 1.7 2001/11/27 13:30:54 dkf Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+test switch-1.1 {simple patterns} {
+    switch a a {format 1} b {format 2} c {format 3} default {format 4}
+} 1
+test switch-1.2 {simple patterns} {
+    switch b a {format 1} b {format 2} c {format 3} default {format 4}
+} 2
+test switch-1.3 {simple patterns} {
+    switch x a {format 1} b {format 2} c {format 3} default {format 4}
+} 4
+test switch-1.4 {simple patterns} {
+    switch x a {format 1} b {format 2} c {format 3}
+} {}
+test switch-1.5 {simple pattern matches many times} {
+    switch b a {format 1} b {format 2} b {format 3} b {format 4}
+} 2
+test switch-1.6 {simple patterns} {
+    switch default a {format 1} default {format 2} c {format 3} default {format 4}
+} 2
+test switch-1.7 {simple patterns} {
+    switch x a {format 1} default {format 2} c {format 3} default {format 4}
+} 4
+
+test switch-2.1 {single-argument form for pattern/command pairs} {
+    switch b {
+	a {format 1}
+	b {format 2}
+	default {format 6}
+    }
+} {2}
+test switch-2.2 {single-argument form for pattern/command pairs} {
+    list [catch {switch z {a 2 b}} msg] $msg
+} {1 {extra switch pattern with no body}}
+
+test switch-3.1 {-exact vs. -glob vs. -regexp} {
+    switch -exact aaaab {
+	^a*b$	{concat regexp}
+	*b	{concat glob}
+	aaaab	{concat exact}
+	default	{concat none}
+    }
+} exact
+test switch-3.2 {-exact vs. -glob vs. -regexp} {
+    switch -regexp aaaab {
+	^a*b$	{concat regexp}
+	*b	{concat glob}
+	aaaab	{concat exact}
+	default	{concat none}
+    }
+} regexp
+test switch-3.3 {-exact vs. -glob vs. -regexp} {
+    switch -glob aaaab {
+	^a*b$	{concat regexp}
+	*b	{concat glob}
+	aaaab	{concat exact}
+	default	{concat none}
+    }
+} glob
+test switch-3.4 {-exact vs. -glob vs. -regexp} {
+    switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
+	    aaaab {concat exact} default {concat none}
+} exact
+test switch-3.5 {-exact vs. -glob vs. -regexp} {
+    switch -- -glob {
+	^g.*b$	{concat regexp}
+	-*	{concat glob}
+	-glob	{concat exact}
+	default {concat none}
+    }
+} exact
+test switch-3.6 {-exact vs. -glob vs. -regexp} {
+    list [catch {switch -foo a b c} msg] $msg
+} {1 {bad option "-foo": must be -exact, -glob, -regexp, or --}}
+
+test switch-4.1 {error in executed command} {
+    list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
+	    $msg $errorInfo
+} {1 {Just a test} {Just a test
+    while executing
+"error "Just a test""
+    ("a" arm line 1)
+    invoked from within
+"switch a a {error "Just a test"} default {format 1}"}}
+test switch-4.2 {error: not enough args} {
+    list [catch {switch} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
+test switch-4.3 {error: pattern with no body} {
+    list [catch {switch a b} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-4.4 {error: pattern with no body} {
+    list [catch {switch a b {format 1} c} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-4.5 {error in default command} {
+    list [catch {switch foo a {error switch1} b {error switch 3} \
+	    default {error switch2}} msg] $msg $errorInfo
+} {1 switch2 {switch2
+    while executing
+"error switch2"
+    ("default" arm line 1)
+    invoked from within
+"switch foo a {error switch1} b {error switch 3}  default {error switch2}"}}
+
+test switch-5.1 {errors in -regexp matching} {
+    list [catch {switch -regexp aaaab {
+	*b	{concat glob}
+	aaaab	{concat exact}
+	default	{concat none}
+    }} msg] $msg
+} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
+
+test switch-6.1 {backslashes in patterns} {
+    switch -exact {\a\$\.\[} {
+	\a\$\.\[	{concat first}
+	\a\\$\.\\[	{concat second}
+	\\a\\$\\.\\[	{concat third}
+	{\a\\$\.\\[}	{concat fourth}
+	{\\a\\$\\.\\[}	{concat fifth}
+	default		{concat none}
+    }
+} third
+test switch-6.2 {backslashes in patterns} {
+    switch -exact {\a\$\.\[} {
+	\a\$\.\[	{concat first}
+	{\a\$\.\[}	{concat second}
+	{{\a\$\.\[}}	{concat third}
+	default		{concat none}
+    }
+} second
+
+test switch-7.1 {"-" bodies} {
+    switch a {
+	a -
+	b -
+	c {concat 1}
+	default {concat 2}
+    }
+} 1
+test switch-7.2 {"-" bodies} {
+    list [catch {
+	switch a {
+	    a -
+	    b -
+	    c -
+	}
+    } msg] $msg
+} {1 {no body specified for pattern "c"}}
+test switch-7.3 {"-" bodies} {
+    list [catch {
+	switch a {
+	    a -
+	    b -foo
+	    c -
+	}
+    } msg] $msg
+} {1 {no body specified for pattern "c"}}
+
+test switch-8.1 {empty body} {
+    set msg {}
+    switch {2} {
+    	1 {set msg 1}
+        2 {}
+        default {set msg 2}
+    }
+} {}
+
+test switch-9.1 {empty pattern/body list} {
+    list [catch {switch x} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
+test switch-9.2 {empty pattern/body list} {
+    list [catch {switch -- x} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
+test switch-9.3 {empty pattern/body list} {
+    list [catch {switch x {}} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
+test switch-9.4 {empty pattern/body list} {
+    list [catch {switch -- x {}} msg] $msg
+} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
+test switch-9.5 {unpaired pattern} {
+    list [catch {switch x a {} b} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-9.6 {unpaired pattern} {
+    list [catch {switch x {a {} b}} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-9.7 {unpaired pattern} {
+    list [catch {switch x a {} # comment b} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-9.8 {unpaired pattern} {
+    list [catch {switch x {a {} # comment b}} msg] $msg
+} {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}}
+test switch-9.9 {unpaired pattern} {
+    list [catch {switch x a {} x {} # comment b} msg] $msg
+} {1 {extra switch pattern with no body}}
+test switch-9.10 {unpaired pattern} {
+    list [catch {switch x {a {} x {} # comment b}} msg] $msg
+} {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}}
+
+# cleanup
+::tcltest::cleanupTests
+return