summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2019-01-13 15:43:53 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2019-01-13 15:43:53 (GMT)
commit4249bc4671e97ae1cbc635dcbb3a91e25d6ce37b (patch)
tree74a85eeb30e23401fa7a5cb3039f6cacc21ba130 /tests
parent6504b376c3d1878dd2acb60c9ac6065a51305fed (diff)
parent631a3b78cb6c86df02039a5cd711ac322b932477 (diff)
downloadtcl-4249bc4671e97ae1cbc635dcbb3a91e25d6ce37b.zip
tcl-4249bc4671e97ae1cbc635dcbb3a91e25d6ce37b.tar.gz
tcl-4249bc4671e97ae1cbc635dcbb3a91e25d6ce37b.tar.bz2
Merge 8.6
Diffstat (limited to 'tests')
-rw-r--r--tests/lrange.test26
1 files changed, 26 insertions, 0 deletions
diff --git a/tests/lrange.test b/tests/lrange.test
index e12e1a4..dcc0eec 100644
--- a/tests/lrange.test
+++ b/tests/lrange.test
@@ -15,6 +15,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testpurebytesobj [llength [info commands testpurebytesobj]]
+
test lrange-1.1 {range of list elements} {
lrange {a b c d} 1 2
@@ -116,6 +122,26 @@ test lrange-3.7b {not compiled on empty not canonical list (with static and dyna
list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \
[$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1]
} [lrepeat 6 {}]
+# following 4 tests could cause a segfault on empty non-lists with tclEmptyStringRep
+# (as before the fix [58c46e74b931d3a1]):
+test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
+ list [lrange {} 0 1] [lrange [lindex a -1] 0 1] [lrange [set a {}] 0 1] \
+ [lrange {} 0-1 end+1] [lrange [lindex a -1] 0-1 end+1] [lrange $a 0-1 end+1]
+} [lrepeat 6 {}]
+test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
+ set cmd lrange
+ list [$cmd {} 0 1] [$cmd [lindex a -1] 0 1] [$cmd [set a {}] 0 1] \
+ [$cmd {} 0-1 end+1] [$cmd [lindex a -1] 0-1 end+1] [$cmd $a 0-1 end+1]
+} [lrepeat 6 {}]
+test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} {
+ list [lrange [testpurebytesobj] 0 1] [lrange [testpurebytesobj { }] 0 1] [lrange [set a [testpurebytesobj {}]] 0 1] \
+ [lrange [testpurebytesobj] 0-1 end+1] [lrange [testpurebytesobj { }] 0-1 end+1] [lrange $a 0-1 end+1]
+} [lrepeat 6 {}]
+test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} {
+ set cmd lrange
+ list [$cmd [testpurebytesobj] 0 1] [$cmd [testpurebytesobj { }] 0 1] [$cmd [set a [testpurebytesobj {}]] 0 1] \
+ [$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1]
+} [lrepeat 6 {}]
test lrange-4.1 {lrange pure promise} -body {
set ll1 [list $tcl_version 2 3 4]