summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2020-03-13 11:15:46 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2020-03-13 11:15:46 (GMT)
commitf285f8aecc735797d5eccc386408a685688354fe (patch)
treeee6db373c1a507ae8b563f62f2ec5b1f497c61b3 /tests
parent55e4ded8d401ba0592671524d13fce2728da1cc7 (diff)
parent49b167a3881644c6aee6b73d87e4edd13a50ce29 (diff)
downloadtcl-f285f8aecc735797d5eccc386408a685688354fe.zip
tcl-f285f8aecc735797d5eccc386408a685688354fe.tar.gz
tcl-f285f8aecc735797d5eccc386408a685688354fe.tar.bz2
Merge trunk
Diffstat (limited to 'tests')
-rw-r--r--tests/assemble.test80
-rw-r--r--tests/binary.test12
-rw-r--r--tests/lpop.test33
3 files changed, 58 insertions, 67 deletions
diff --git a/tests/assemble.test b/tests/assemble.test
index 8c50500..d417d4b 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -1524,61 +1524,35 @@ test assemble-14.7 {incrArrayStkImm} {
# assemble-15 - listIndexImm
-test assemble-15.1 {listIndexImm - wrong # args} {
- -body {
- assemble {listIndexImm}
- }
- -returnCodes error
- -match glob
- -result {wrong # args*}
-}
-test assemble-15.2 {listIndexImm - wrong # args} {
- -body {
- assemble {listIndexImm too many}
- }
- -returnCodes error
- -match glob
- -result {wrong # args*}
-}
-test assemble-15.3 {listIndexImm - bad substitution} {
- -body {
- list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode
- }
- -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
- -cleanup {unset result}
-}
-test assemble-15.4 {listIndexImm - invalid index} {
- -body {
- assemble {listIndexImm rubbish}
- }
- -returnCodes error
- -match glob
- -result {bad index "rubbish"*}
-}
-test assemble-15.5 {listIndexImm} {
- -body {
- assemble {push {a b c}; listIndexImm 2}
- }
- -result c
-}
-test assemble-15.6 {listIndexImm} {
- -body {
- assemble {push {a b c}; listIndexImm end-1}
- }
- -result b
-}
-test assemble-15.7 {listIndexImm} {
- -body {
- assemble {push {a b c}; listIndexImm end}
- }
- -result c
-}
-test assemble-15.8 {listIndexImm} {
+test assemble-15.1 {listIndexImm - wrong # args} -body {
+ assemble {listIndexImm}
+} -returnCodes error -match glob -result {wrong # args*}
+test assemble-15.2 {listIndexImm - wrong # args} -body {
+ assemble {listIndexImm too many}
+} -returnCodes error -match glob -result {wrong # args*}
+test assemble-15.3 {listIndexImm - bad substitution} -body {
+ list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode
+} -cleanup {
+ unset result
+} -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+test assemble-15.4 {listIndexImm - invalid index} -body {
+ assemble {listIndexImm rubbish}
+} -returnCodes error -match glob -result {bad index "rubbish"*}
+test assemble-15.5 {listIndexImm} -body {
+ assemble {push {a b c}; listIndexImm 2}
+} -result c
+test assemble-15.6 {listIndexImm} -body {
+ assemble {push {a b c}; listIndexImm end-1}
+} -result b
+test assemble-15.7 {listIndexImm} -body {
+ assemble {push {a b c}; listIndexImm end}
+} -result c
+test assemble-15.8 {listIndexImm} -body {
assemble {push {a b c}; listIndexImm end+2}
-} {}
-test assemble-15.9 {listIndexImm} {
+} -result {}
+test assemble-15.9 {listIndexImm} -body {
assemble {push {a b c}; listIndexImm -1-1}
-} {}
+} -result {}
# assemble-16 - invokeStk
diff --git a/tests/binary.test b/tests/binary.test
index e77dbdd..4e0944b 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -2918,6 +2918,18 @@ test binary-78.1 {unicode (out of BMP) to byte-array conversion, bug-[bd94500678
set str {}
} -result * -match glob -returnCodes error
+
+testConstraint testsetbytearraylength \
+ [expr {"testsetbytearraylength" in [info commands]}]
+
+test binary-79.1 {Tcl_SetByteArrayLength} testsetbytearraylength {
+ testsetbytearraylength [string cat A B C] 1
+} A
+test binary-79.2 {Tcl_SetByteArrayLength} testsetbytearraylength {
+ testsetbytearraylength [string cat \u0141 B C] 1
+} A
+
+
# ----------------------------------------------------------------------
# cleanup
diff --git a/tests/lpop.test b/tests/lpop.test
index 89b651c..3e28978 100644
--- a/tests/lpop.test
+++ b/tests/lpop.test
@@ -16,6 +16,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+unset -nocomplain no; # following tests expecting var "no" does not exists
test lpop-1.1 {error conditions} -returnCodes error -body {
lpop no
} -result {can't read "no": no such variable}
@@ -23,32 +24,36 @@ test lpop-1.2 {error conditions} -returnCodes error -body {
lpop no 0
} -result {can't read "no": no such variable}
test lpop-1.3 {error conditions} -returnCodes error -body {
- set no "x {}x"
- lpop no
+ set l "x {}x"
+ lpop l
} -result {list element in braces followed by "x" instead of space}
test lpop-1.4 {error conditions} -returnCodes error -body {
- set no "x y"
- lpop no -1
+ set l "x y"
+ lpop l -1
} -result {index "-1" out of range}
+test lpop-1.4b {error conditions (also check SF on empty list variable, bug [234d6c811d])} -body {
+ set l "x y"
+ list [lpop l] [lpop l] [catch {lpop l} v] $v [catch {lpop l 0} v] $v $l
+} -result {y x 1 {index "end" out of range} 1 {index "0" out of range} {}}
test lpop-1.5 {error conditions} -returnCodes error -body {
- set no "x y z"
- lpop no 3
+ set l "x y z"
+ lpop l 3
} -result {index "3" out of range} ;#-errorCode {TCL OPERATION LPOP BADINDEX}
test lpop-1.6 {error conditions} -returnCodes error -body {
- set no "x y"
- lpop no end+1
+ set l "x y"
+ lpop l end+1
} -result {index "end+1" out of range}
test lpop-1.7 {error conditions} -returnCodes error -body {
- set no "x y"
- lpop no {}
+ set l "x y"
+ lpop l {}
} -match glob -result {bad index *}
test lpop-1.8 {error conditions} -returnCodes error -body {
- set no "x y"
- lpop no 0 0 0 0 1
+ set l "x y"
+ lpop l 0 0 0 0 1
} -result {index "1" out of range}
test lpop-1.9 {error conditions} -returnCodes error -body {
- set no "x y"
- lpop no {1 0}
+ set l "x y"
+ lpop l {1 0}
} -match glob -result {bad index *}
test lpop-2.1 {basic functionality} -body {