diff options
author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2018-01-12 16:30:03 (GMT) |
---|---|---|
committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2018-01-12 16:30:03 (GMT) |
commit | f0b9b9fbb6d6275b0be9047cee3a2fbdfb9ecdd4 (patch) | |
tree | c8f5508e0e76991c70aa2c0d58514db18ed3aeb5 /tests | |
parent | 88233497abccd1215abfc8e09aeda7bf4fea2931 (diff) | |
parent | 244885a03e8d66f5500058eaf820d6b47f292007 (diff) | |
download | tcl-f0b9b9fbb6d6275b0be9047cee3a2fbdfb9ecdd4.zip tcl-f0b9b9fbb6d6275b0be9047cee3a2fbdfb9ecdd4.tar.gz tcl-f0b9b9fbb6d6275b0be9047cee3a2fbdfb9ecdd4.tar.bz2 |
merge core-8-branch
Diffstat (limited to 'tests')
-rw-r--r-- | tests/basic.test | 10 | ||||
-rw-r--r-- | tests/fileSystem.test | 16 | ||||
-rw-r--r-- | tests/namespace.test | 32 | ||||
-rw-r--r-- | tests/oo.test | 13 | ||||
-rw-r--r-- | tests/safe.test | 8 | ||||
-rw-r--r-- | tests/scan.test | 2 | ||||
-rw-r--r-- | tests/string.test | 4 | ||||
-rw-r--r-- | tests/utf.test | 2 |
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} |