summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/aaa_exit.test54
-rw-r--r--tests/error.test6
-rw-r--r--tests/lreplace.test14
-rw-r--r--tests/oo.test10
-rw-r--r--tests/regexpComp.test5
-rw-r--r--tests/upvar.test3
-rw-r--r--tests/var.test2
7 files changed, 90 insertions, 4 deletions
diff --git a/tests/aaa_exit.test b/tests/aaa_exit.test
new file mode 100644
index 0000000..3ba5167
--- /dev/null
+++ b/tests/aaa_exit.test
@@ -0,0 +1,54 @@
+# Commands covered: exit, emphasis on finalization hangs
+#
+# 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) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1997 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 {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest 2
+ namespace import -force ::tcltest::*
+}
+
+test exit-1.1 {normal, quick exit} {
+ set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\"" r]
+ set aft [after 1000 {set done "Quick exit hangs !!!"}]
+ fileevent $f readable {after cancel $aft;set done OK}
+ vwait done
+ if {$done != "OK"} {
+ fconfigure $f -blocking 0
+ close $f
+ } else {
+ if {[catch {close $f} err]} {
+ set done "Quick exit misbehaves: $err"
+ }
+ }
+ set done
+} OK
+
+test exit-1.2 {full-finalized exit} {
+ set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 1;exit}\"" r]
+ set aft [after 1000 {set done "Full-finalized exit hangs !!!"}]
+ fileevent $f readable {after cancel $aft;set done OK}
+ vwait done
+ if {$done != "OK"} {
+ fconfigure $f -blocking 0
+ close $f
+ } else {
+ if {[catch {close $f} err]} {
+ set done "Full-finalized exit misbehaves: $err"
+ }
+ }
+ set done
+} OK
+
+
+# cleanup
+::tcltest::cleanupTests
+return
diff --git a/tests/error.test b/tests/error.test
index 0de644c..af07ed7 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -1184,6 +1184,12 @@ test error-21.8 {memory leaks in try: Bug 2910044} memory {
}
} 0
+test error-21.9 {Bug cee90e4e88} {
+ # Just don't panic.
+ apply {{} {try {} on ok {} - on return {} {}}}
+} {}
+
+
# negative case try tests - bad "trap" handler
# what is the effect if we attempt to trap an errorcode that is not a list?
# nested try
diff --git a/tests/lreplace.test b/tests/lreplace.test
index 5f675bc..b976788 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -15,7 +15,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
-
+
test lreplace-1.1 {lreplace command} {
lreplace {1 2 3 4 5} 0 0 a
} {a 2 3 4 5}
@@ -130,7 +130,19 @@ test lreplace-3.1 {lreplace won't modify shared argument objects} {
p
} "a b c"
+test lreplace-4.1 {Bug ccc2c2cc98: lreplace edge case} {
+ lreplace {} 1 1
+} {}
+# Note that this test will fail in 8.5
+test lreplace-4.2 {Bug ccc2c2cc98: lreplace edge case} {
+ lreplace { } 1 1
+} {}
+
# cleanup
catch {unset foo}
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/oo.test b/tests/oo.test
index 8c515da..2c189ca 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -271,6 +271,16 @@ test oo-1.18.1 {Bug 75b8433707: memory leak in oo-1.18} -setup {
} -cleanup {
rename test-oo-1.18 {}
} -result 0
+test oo-1.18.2 {Bug 21c144f0f5} -setup {
+ interp create slave
+} -body {
+ slave eval {
+ oo::define [oo::class create foo] superclass oo::class
+ oo::class destroy
+ }
+} -cleanup {
+ interp delete slave
+}
test oo-1.19 {basic test of OO functionality: teardown order} -body {
oo::object create o
namespace delete [info object namespace o]
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index 7be1195..01ef06d 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -526,6 +526,11 @@ test regexpComp-9.6 {-all option to regsub} {
list [regsub -all ^ xxx 123 foo] $foo
}
} {1 123xxx}
+test regexpComp-9.7 {Bug 84af1192f5: -all option to regsub} {
+ evalInProc {
+ regsub -all {\(.*} 123(qwe) ""
+ }
+} 123
test regexpComp-10.1 {expanded syntax in regsub} {
evalInProc {
diff --git a/tests/upvar.test b/tests/upvar.test
index e93f58a..5ea870d 100644
--- a/tests/upvar.test
+++ b/tests/upvar.test
@@ -339,7 +339,7 @@ test upvar-8.9 {upvar won't create namespace variable that refers to procedure v
unset ::test_ns_1::a
}
MakeLink 1
-} -result {bad variable name "a": upvar won't create namespace variable that refers to procedure variable}
+} -result {bad variable name "a": can't create namespace variable that refers to procedure variable}
test upvar-8.10 {upvar will create element alias for new array element} -setup {
catch {unset upvarArray}
} -body {
@@ -578,7 +578,6 @@ test upvar-NS-3.3 {CompileWord OBOE} -setup {
} -cleanup {
rename linenumber {}
} -result 1
-
# cleanup
::tcltest::cleanupTests
diff --git a/tests/var.test b/tests/var.test
index 208b361..8e862f7 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -289,7 +289,7 @@ test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
} -returnCodes error -body {
set aaaaa 789789
upvar #0 aaaaa foo(bar)
-} -result {bad variable name "foo(bar)": upvar won't create a scalar variable that looks like an array element}
+} -result {bad variable name "foo(bar)": can't create a scalar variable that looks like an array element}
test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname {
catch {unset a}