summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2011-05-10 16:05:48 (GMT)
committerdgp <dgp@users.sourceforge.net>2011-05-10 16:05:48 (GMT)
commitf9dece7738d140a66ebb5d47ee85c4d57249258a (patch)
tree1ca2feda250662282a8e77080fef123d9256b839 /tests
parentb1c2f2c9c6fcb329f1e23f9f5f1ef53c84b01bae (diff)
downloadtcl-f9dece7738d140a66ebb5d47ee85c4d57249258a.zip
tcl-f9dece7738d140a66ebb5d47ee85c4d57249258a.tar.gz
tcl-f9dece7738d140a66ebb5d47ee85c4d57249258a.tar.bz2
Completed patch with mucho comments. Merge 8.5.bug_3173086
Diffstat (limited to 'tests')
-rw-r--r--tests/namespace.test23
-rw-r--r--tests/parse.test12
-rw-r--r--tests/string.test11
3 files changed, 37 insertions, 9 deletions
diff --git a/tests/namespace.test b/tests/namespace.test
index 89f6759..504d532 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -24,6 +24,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# Clear out any namespaces called test_ns_*
catch {namespace delete {*}[namespace children :: test_ns_*]}
+proc fq {ns} {
+ if {[string match ::* $ns]} {return $ns}
+ set current [uplevel 1 {namespace current}]
+ return [string trimright $current :]::[string trimleft $ns :]
+}
+
test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
namespace children :: test_ns_*
} {}
@@ -929,9 +935,8 @@ test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} {
namespace eval test_ns_1 {}
- namespace children [namespace current] \
- [string trimright [namespace current] :]::test_ns_1
-} [string trimright [namespace current] :]::test_ns_1
+ namespace children [namespace current] [fq test_ns_1]
+} [fq test_ns_1]
test namespace-22.1 {NamespaceCodeCmd, bad args} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -942,11 +947,11 @@ test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
namespace eval test_ns_1 {
proc cmd {} {return "test_ns_1::cmd"}
}
- namespace code {namespace inscope ::test_ns_1 cmd}
-} {namespace inscope ::test_ns_1 cmd}
+ namespace code {::namespace inscope ::test_ns_1 cmd}
+} {::namespace inscope ::test_ns_1 cmd}
test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
namespace code {namespace inscope ::test_ns_1 cmd}
-} {namespace inscope ::test_ns_1 cmd}
+} {::namespace inscope :: {namespace inscope ::test_ns_1 cmd}}
test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
namespace code unknown
} {::namespace inscope :: unknown}
@@ -966,6 +971,12 @@ test namespace-22.6 {NamespaceCodeCmd, in other namespace} {
namespace code {set v}
}]
} {42}
+test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} {
+ namespace eval demo {
+ proc namespace args {puts $args}
+ ::namespace code {namespace inscope foo}
+ }
+} [list ::namespace inscope [fq demo] {namespace inscope foo}]
test namespace-23.1 {NamespaceCurrentCmd, bad args} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
diff --git a/tests/parse.test b/tests/parse.test
index b5211e7..37c44d5 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -227,6 +227,18 @@ test parse-5.26 {Tcl_ParseCommand: {*} parsing} testparser {
test parse-5.27 {Tcl_ParseCommand: {*} parsing} testparser {
testparser "{*}\\\n foo bar" 0
} {- \{*\}\\\n\ foo\ bar 3 simple {{*}} 1 text * 0 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
+test parse-5.28 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser {
+ testparser {{*}{a b}} 0
+} {- {{*}{a b}} 2 simple a 1 text a 0 simple b 1 text b 0 {}}
+test parse-5.29 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser {
+ testparser {{*}{a \n b}} 0
+} {- {{*}{a \n b}} 1 expand {{*}{a \n b}} 1 text {a \n b} 0 {}}
+test parse-5.30 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser {
+ testparser {{*}"a b"} 0
+} {- {{*}"a b"} 2 simple a 1 text a 0 simple b 1 text b 0 {}}
+test parse-5.31 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser {
+ testparser {{*}"a \n b"} 0
+} {- {{*}"a \n b"} 1 expand {{*}"a \n b"} 3 text {a } 0 backslash {\n} 0 text { b} 0 {}}
test parse-6.1 {ParseTokens procedure, empty word} testparser {
testparser {""} 0
diff --git a/tests/string.test b/tests/string.test
index 6b00f3a..c3cfc3c 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -601,18 +601,18 @@ test string-6.91 {string is double, bad doubles} {
}
set result
} {1 1 0 0 0 1 0 0}
-test string-6.92 {string is double, 32-bit overflow} {
+test string-6.92 {string is integer, 32-bit overflow} {
# Bug 718878
set x 0x100000000
list [string is integer -failindex var $x] $var
} {0 -1}
-test string-6.93 {string is double, 32-bit overflow} {
+test string-6.93 {string is integer, 32-bit overflow} {
# Bug 718878
set x 0x100000000
append x ""
list [string is integer -failindex var $x] $var
} {0 -1}
-test string-6.94 {string is double, 32-bit overflow} {
+test string-6.94 {string is integer, 32-bit overflow} {
# Bug 718878
set x 0x100000000
list [string is integer -failindex var [expr {$x}]] $var
@@ -1608,6 +1608,11 @@ test string-24.11 {string reverse command - corner case} {
set y \udead
string reverse $x$y
} \udead\ubeef
+test string-24.12 {string reverse command - corner case} {
+ set x \ubeef
+ set y \udead
+ string is ascii [string reverse $x$y]
+} 0
test string-25.1 {string is list} {
string is list {a b c}