summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2018-01-12 16:30:03 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2018-01-12 16:30:03 (GMT)
commitf0b9b9fbb6d6275b0be9047cee3a2fbdfb9ecdd4 (patch)
treec8f5508e0e76991c70aa2c0d58514db18ed3aeb5 /tests
parent88233497abccd1215abfc8e09aeda7bf4fea2931 (diff)
parent244885a03e8d66f5500058eaf820d6b47f292007 (diff)
downloadtcl-f0b9b9fbb6d6275b0be9047cee3a2fbdfb9ecdd4.zip
tcl-f0b9b9fbb6d6275b0be9047cee3a2fbdfb9ecdd4.tar.gz
tcl-f0b9b9fbb6d6275b0be9047cee3a2fbdfb9ecdd4.tar.bz2
merge core-8-branch
Diffstat (limited to 'tests')
-rw-r--r--tests/basic.test10
-rw-r--r--tests/fileSystem.test16
-rw-r--r--tests/namespace.test32
-rw-r--r--tests/oo.test13
-rw-r--r--tests/safe.test8
-rw-r--r--tests/scan.test2
-rw-r--r--tests/string.test4
-rw-r--r--tests/utf.test2
8 files changed, 73 insertions, 14 deletions
diff --git a/tests/basic.test b/tests/basic.test
index 7819241..d47613a 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -984,6 +984,16 @@ test basic-49.2 {Tcl_EvalEx: verify TCL_EVAL_GLOBAL operation} testevalex {
set ::context
} {global}
+test basic-50.1 {[586e71dce4] EvalObjv level #0 exception handling} -setup {
+ interp create slave
+ interp alias {} foo slave return
+} -body {
+ list [catch foo m] $m
+} -cleanup {
+ unset -nocomplain m
+ interp delete slave
+} -result {0 {}}
+
# Clean up after expand tests
unset noComp l1 l2 constraints
rename l3 {}
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 4c90376..0dd0bdb 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -377,6 +377,22 @@ test filesystem-1.52.1 {bug f9f390d0fa: file join where strep is not canonical}
file normalize $x
file join $x
} -result /foo
+test filesystem-1.53 {[Bug 3559678] - normalize when tail is empty} {
+ string match */ [file normalize [lindex [glob -dir [pwd] {{}}] 0]]
+} 0
+test filesystem-1.54 {[Bug ce3a211dcb] - normalize when tail is empty} -setup {
+ set save [pwd]
+ cd [set home [makeDirectory ce3a211dcb]]
+ makeDirectory A $home
+ cd [lindex [glob */] 0]
+} -body {
+ string match */A [pwd]
+} -cleanup {
+ cd $home
+ removeDirectory A $home
+ cd $save
+ removeDirectory ce3a211dcb
+} -result 1
test filesystem-2.0 {new native path} {unix} {
foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
diff --git a/tests/namespace.test b/tests/namespace.test
index 5387ae8..b9e6ead 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -196,6 +196,19 @@ test namespace-7.7 {Bug 1655305} -setup {
interp delete slave
} -result {}
+test namespace-7.8 {Bug ba1419303b4c} -setup {
+ namespace eval ns1 {
+ namespace ensemble create
+ }
+
+ trace add command ns1 delete {
+ namespace delete ns1
+ }
+} -body {
+ # No segmentation fault given --enable-symbols=mem.
+ namespace delete ns1
+} -result {}
+
test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
catch {interp delete test_interp}
interp create test_interp
@@ -1808,14 +1821,29 @@ test namespace-42.9 {
deallocated List struct.
} -setup {
namespace eval n {namespace ensemble create}
- dict set list one ::two
- namespace ensemble configure n -subcommands $list -map $list
+ set lst [dict create one ::two]
+ namespace ensemble configure n -subcommands $lst -map $lst
} -body {
n one
} -cleanup {
namespace delete n
+ unset -nocomplain lst
} -returnCodes error -match glob -result {invalid command name*}
+test namespace-42.10 {
+ ensembles: [Bug 4f6a1ebd64] segmentation fault due to pointer to a
+ deallocated List struct (this time with duplicate of one in "dict").
+} -setup {
+ namespace eval n {namespace ensemble create}
+ set lst [list one ::two one ::three]
+ namespace ensemble configure n -subcommands $lst -map $lst
+} -body {
+ n one
+} -cleanup {
+ namespace delete n
+ unset -nocomplain lst
+} -returnCodes error -match glob -result {invalid command name *three*}
+
test namespace-43.1 {ensembles: dict-driven} {
namespace eval ns {
namespace export x*
diff --git a/tests/oo.test b/tests/oo.test
index b9c5067..3be5f79 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -47,7 +47,7 @@ test oo-0.2 {basic test of OO's ability to clean up its initial state} {
} {}
test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
leaktest {
- [oo::object new] destroy
+ [oo::object new] destroy
}
} -constraints memory -result 0
test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
@@ -131,6 +131,10 @@ test oo-1.4 {basic test of OO functionality} -body {
test oo-1.4.1 {fully-qualified nested name} -body {
oo::object create ::one::two::three
} -result {::one::two::three}
+test oo-1.4.2 {automatic command name has same name as namespace} -body {
+ set obj [oo::object new]
+ expr {[info object namespace $obj] == $obj}
+} -result 1
test oo-1.5 {basic test of OO functionality} -body {
oo::object doesnotexist
} -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new}
@@ -1514,9 +1518,9 @@ test oo-11.6 {
# No segmentation fault
return done
-} -cleanup {
+} -result done -cleanup {
rename obj1 {}
-} -result done
+}
test oo-12.1 {OO: filters} {
oo::class create Aclass
@@ -3891,9 +3895,6 @@ test oo-35.6 {
rename obj {}
} -result done
-
-
-
test oo-36.1 {TIP #470: introspection within oo::define} {
oo::define oo::object self
} ::oo::object
diff --git a/tests/safe.test b/tests/safe.test
index 33ee166..df60de6 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -180,17 +180,17 @@ test safe-6.3 {test safe interpreters knowledge of the world} {
# leaking infos, but they still do...
# high level general test
-test safe-7.1 {tests that everything works at high level} {
+test safe-7.1 {tests that everything works at high level} -body {
set i [safe::interpCreate]
# no error shall occur:
# (because the default access_path shall include 1st level sub dirs so
# package require in a slave works like in the master)
- set v [interp eval $i {package require http 1}]
+ set v [interp eval $i {package require http 2}]
# no error shall occur:
- interp eval $i {http_config}
+ interp eval $i {http::config}
safe::interpDelete $i
set v
-} 1.0
+} -match glob -result 2.*
test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
# should not add anything (p0)
diff --git a/tests/scan.test b/tests/scan.test
index b36b412..98c581b 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -553,7 +553,7 @@ test scan-5.18 {bigint scanning underflow} -setup {
list [scan "-207698809136909011942886895" \
%llu a] $a
} -returnCodes 1 -result {unsigned bignum scans are invalid}
-test scan-5.18 {bigint scanning invalid} -setup {
+test scan-5.19 {bigint scanning invalid} -setup {
set a {};
} -body {
list [scan "207698809136909011942886895" \
diff --git a/tests/string.test b/tests/string.test
index cebaf4c..b75c900 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -24,6 +24,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
+testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
@@ -1288,6 +1289,9 @@ test string-12.22 {string range, shimmering binary/index} {
binary scan $s a* x
string range $s $s end
} 000000001
+test string-12.23 {string range, surrogates, bug [11ae2be95dac9417]} fullutf {
+ list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]
+} [list \U100000 {} b]
test string-13.1 {string repeat} {
list [catch {string repeat} msg] $msg
diff --git a/tests/utf.test b/tests/utf.test
index d0fa7be..95775a8 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -124,7 +124,7 @@ test utf-4.10 {Tcl_NumUtfChars: #u0000, calc len, overcomplete} {testnumutfchars
test utf-5.1 {Tcl_UtfFindFirst} {testfindfirst testbytestring} {
testfindfirst [testbytestring "abcbc"] 98
} {bcbc}
-test utf-5.1 {Tcl_UtfFindLast} {testfindlast testbytestring} {
+test utf-5.2 {Tcl_UtfFindLast} {testfindlast testbytestring} {
testfindlast [testbytestring "abcbc"] 98
} {bc}