summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2008-09-10 13:50:03 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2008-09-10 13:50:03 (GMT)
commita19fa7cdab3e5494e84dd29f64a39ccef1c7e138 (patch)
tree8df6e9d9e084d17a6985e397a5e9fd6ae05bd112
parentb2d9ed24c8428b9c2230515bf13aa76dcfdb607f (diff)
downloadtcl-a19fa7cdab3e5494e84dd29f64a39ccef1c7e138.zip
tcl-a19fa7cdab3e5494e84dd29f64a39ccef1c7e138.tar.gz
tcl-a19fa7cdab3e5494e84dd29f64a39ccef1c7e138.tar.bz2
Use the powers of tcltest2 for good! Also add basic testing of disassmbler
(though not of its output format).
-rw-r--r--ChangeLog7
-rw-r--r--tests/binary.test1503
-rw-r--r--tests/cmdAH.test7
-rw-r--r--tests/cmdIL.test370
-rw-r--r--tests/cmdMZ.test269
-rw-r--r--tests/compile.test87
-rw-r--r--tests/fileSystem.test598
7 files changed, 1401 insertions, 1440 deletions
diff --git a/ChangeLog b/ChangeLog
index 5c412e3..be63310 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2008-09-10 Donal K. Fellows <dkf@users.sf.net>
+
+ * tests/binary.test,cmdAH.test,cmdIL.test,cmdMZ.test,fileSystem.test:
+ More use of tcltest2 to simplify the tests as exposed to people.
+ * tests/compile.test (compile-18.*): Added *some* tests of the
+ disassmbler, though not of its output format.
+
2008-09-10 Miguel Sofer <msofer@users.sf.net>
* tests/nre.test: add missing constraints; enable test of foreach
diff --git a/tests/binary.test b/tests/binary.test
index 7f41559..8b8a1ab 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -1,16 +1,16 @@
-# This file tests the tclBinary.c file and the "binary" Tcl command.
+# This file tests the tclBinary.c file and the "binary" Tcl command.
#
-# 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.
+# 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) 1997 by 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.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: binary.test,v 1.36 2008/07/23 23:19:33 ferrieux Exp $
+# RCS: @(#) $Id: binary.test,v 1.37 2008/09/10 13:50:04 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -19,35 +19,90 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
+# Big test for correct ordering of data in [expr]
+proc testIEEE {} {
+ variable ieeeValues
+ binary scan [binary format dd -1.0 1.0] c* c
+ switch -exact -- $c {
+ {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
+ # little endian
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
+ ieeeValues(-Infinity)
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
+ ieeeValues(-Normal)
+ binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
+ ieeeValues(-Subnormal)
+ binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
+ ieeeValues(-0)
+ binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+0)
+ binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
+ ieeeValues(+Subnormal)
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
+ ieeeValues(+Normal)
+ binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
+ ieeeValues(+Infinity)
+ binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
+ ieeeValues(NaN)
+ set ieeeValues(littleEndian) 1
+ return 1
+ }
+ {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
+ binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-Infinity)
+ binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-Normal)
+ binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-Subnormal)
+ binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(-0)
+ binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+0)
+ binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+Subnormal)
+ binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+Normal)
+ binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(+Infinity)
+ binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
+ ieeeValues(NaN)
+ set ieeeValues(littleEndian) 0
+ return 1
+ }
+ default {
+ return 0
+ }
+ }
+}
+
+testConstraint ieeeFloatingPoint [testIEEE]
+
+# ----------------------------------------------------------------------
+
test binary-0.1 {DupByteArrayInternalRep} {
set hdr [binary format cc 0 0316]
set buf hellomatt
-
set data $hdr
append data $buf
-
string length $data
} 11
test binary-1.1 {Tcl_BinaryObjCmd: bad args} -body {
binary
} -returnCodes error -match glob -result {wrong # args: *}
-test binary-1.2 {Tcl_BinaryObjCmd: bad args} -body {
+test binary-1.2 {Tcl_BinaryObjCmd: bad args} -returnCodes error -body {
binary foo
-} -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": *}
-
-test binary-1.3 {Tcl_BinaryObjCmd: format error} -body {
+} -match glob -result {unknown or ambiguous subcommand "foo": *}
+test binary-1.3 {Tcl_BinaryObjCmd: format error} -returnCodes error -body {
binary f
-} -returnCodes error \
- -result {wrong # args: should be "binary format formatString ?arg ...?"}
+} -result {wrong # args: should be "binary format formatString ?arg ...?"}
test binary-1.4 {Tcl_BinaryObjCmd: format} -body {
binary format ""
} -result {}
-
-test binary-2.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format a } msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-2.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format a
+} -result {not enough arguments for all format specifiers}
test binary-2.2 {Tcl_BinaryObjCmd: format} {
binary format a0 foo
} {}
@@ -70,9 +125,9 @@ test binary-2.8 {Tcl_BinaryObjCmd: format} {
binary format a*X3a2 foobar x
} foox\x00r
-test binary-3.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format A} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-3.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format A
+} -result {not enough arguments for all format specifiers}
test binary-3.2 {Tcl_BinaryObjCmd: format} {
binary format A0 f
} {}
@@ -95,9 +150,9 @@ test binary-3.8 {Tcl_BinaryObjCmd: format} {
binary format A*X3A2 foobar x
} {foox r}
-test binary-4.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format B} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-4.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format B
+} -result {not enough arguments for all format specifiers}
test binary-4.2 {Tcl_BinaryObjCmd: format} {
binary format B0 1
} {}
@@ -119,13 +174,13 @@ test binary-4.7 {Tcl_BinaryObjCmd: format} {
test binary-4.8 {Tcl_BinaryObjCmd: format} {
binary format B2B3 10 010
} \x80\x40
-test binary-4.9 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format B1B5 1 foo} msg] $msg
-} {1 {expected binary string but got "foo" instead}}
+test binary-4.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format B1B5 1 foo
+} -result {expected binary string but got "foo" instead}
-test binary-5.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format b} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-5.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format b
+} -result {not enough arguments for all format specifiers}
test binary-5.2 {Tcl_BinaryObjCmd: format} {
binary format b0 1
} {}
@@ -150,13 +205,13 @@ test binary-5.8 {Tcl_BinaryObjCmd: format} {
test binary-5.9 {Tcl_BinaryObjCmd: format} {
binary format b2b3 10 010
} \x01\x02
-test binary-5.10 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format b1b5 1 foo} msg] $msg
-} {1 {expected binary string but got "foo" instead}}
+test binary-5.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format b1b5 1 foo
+} -result {expected binary string but got "foo" instead}
-test binary-6.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format h} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-6.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format h
+} -result {not enough arguments for all format specifiers}
test binary-6.2 {Tcl_BinaryObjCmd: format} {
binary format h0 1
} {}
@@ -184,13 +239,13 @@ test binary-6.9 {Tcl_BinaryObjCmd: format} {
test binary-6.10 {Tcl_BinaryObjCmd: format} {
binary format h2h3 23 456
} \x32\x54\x06
-test binary-6.11 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format h2 foo} msg] $msg
-} {1 {expected hexadecimal string but got "foo" instead}}
+test binary-6.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format h2 foo
+} -result {expected hexadecimal string but got "foo" instead}
-test binary-7.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format H} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-7.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format H
+} -result {not enough arguments for all format specifiers}
test binary-7.2 {Tcl_BinaryObjCmd: format} {
binary format H0 1
} {}
@@ -218,16 +273,16 @@ test binary-7.9 {Tcl_BinaryObjCmd: format} {
test binary-7.10 {Tcl_BinaryObjCmd: format} {
binary format H2H3 23 456
} \x23\x45\x60
-test binary-7.11 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format H2 foo} msg] $msg
-} {1 {expected hexadecimal string but got "foo" instead}}
-
-test binary-8.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format c} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-8.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format c blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-7.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format H2 foo
+} -result {expected hexadecimal string but got "foo" instead}
+
+test binary-8.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format c
+} -result {not enough arguments for all format specifiers}
+test binary-8.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format c blat
+} -result {expected integer but got "blat"}
test binary-8.3 {Tcl_BinaryObjCmd: format} {
binary format c0 0x50
} {}
@@ -246,24 +301,24 @@ test binary-8.7 {Tcl_BinaryObjCmd: format} {
test binary-8.8 {Tcl_BinaryObjCmd: format} {
binary format c* {0x50 0x52}
} PR
-test binary-8.9 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format c2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-8.10 {Tcl_BinaryObjCmd: format} {
+test binary-8.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format c2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-8.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format c $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format c $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-8.11 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format c1 $a
} P
-test binary-9.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format s} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-9.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format s blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-9.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format s
+} -result {not enough arguments for all format specifiers}
+test binary-9.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format s blat
+} -result {expected integer but got "blat"}
test binary-9.3 {Tcl_BinaryObjCmd: format} {
binary format s0 0x50
} {}
@@ -285,24 +340,24 @@ test binary-9.8 {Tcl_BinaryObjCmd: format} {
test binary-9.9 {Tcl_BinaryObjCmd: format} {
binary format s2 {0x50 0x52 0x53} 0x54
} P\x00R\x00
-test binary-9.10 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format s2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-9.11 {Tcl_BinaryObjCmd: format} {
+test binary-9.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format s2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-9.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format s $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format s $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-9.12 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format s1 $a
} P\x00
-test binary-10.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format S} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-10.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format S blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-10.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format S
+} -result {not enough arguments for all format specifiers}
+test binary-10.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format S blat
+} -result {expected integer but got "blat"}
test binary-10.3 {Tcl_BinaryObjCmd: format} {
binary format S0 0x50
} {}
@@ -324,24 +379,24 @@ test binary-10.8 {Tcl_BinaryObjCmd: format} {
test binary-10.9 {Tcl_BinaryObjCmd: format} {
binary format S2 {0x50 0x52 0x53} 0x54
} \x00P\x00R
-test binary-10.10 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format S2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-10.11 {Tcl_BinaryObjCmd: format} {
+test binary-10.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format S2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-10.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format S $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format S $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-10.12 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format S1 $a
} \x00P
-test binary-11.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format i} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-11.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format i blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-11.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format i
+} -result {not enough arguments for all format specifiers}
+test binary-11.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format i blat
+} -result {expected integer but got "blat"}
test binary-11.3 {Tcl_BinaryObjCmd: format} {
binary format i0 0x50
} {}
@@ -366,24 +421,24 @@ test binary-11.9 {Tcl_BinaryObjCmd: format} {
test binary-11.10 {Tcl_BinaryObjCmd: format} {
binary format i* {0x50515253 0x52}
} SRQPR\x00\x00\x00
-test binary-11.11 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format i2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-11.12 {Tcl_BinaryObjCmd: format} {
+test binary-11.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format i2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-11.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format i $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format i $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-11.13 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format i1 $a
} P\x00\x00\x00
-test binary-12.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format I} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-12.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format I blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-12.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format I
+} -result {not enough arguments for all format specifiers}
+test binary-12.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format I blat
+} -result {expected integer but got "blat"}
test binary-12.3 {Tcl_BinaryObjCmd: format} {
binary format I0 0x50
} {}
@@ -408,24 +463,24 @@ test binary-12.9 {Tcl_BinaryObjCmd: format} {
test binary-12.10 {Tcl_BinaryObjCmd: format} {
binary format I* {0x50515253 0x52}
} PQRS\x00\x00\x00R
-test binary-12.11 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format i2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-12.12 {Tcl_BinaryObjCmd: format} {
+test binary-12.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format i2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-12.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format I $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format I $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-12.13 {Tcl_BinaryObjCmd: format} {
set a {0x50 0x51}
binary format I1 $a
} \x00\x00\x00P
-test binary-13.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format f} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-13.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format f blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-13.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format f
+} -result {not enough arguments for all format specifiers}
+test binary-13.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format f blat
+} -result {expected floating-point number but got "blat"}
test binary-13.3 {Tcl_BinaryObjCmd: format} {
binary format f0 1.6
} {}
@@ -465,13 +520,13 @@ test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian {
binary format f -3.402825e-100
} \x00\x00\x00\x80
-test binary-13.16 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format f2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-13.17 {Tcl_BinaryObjCmd: format} {
+test binary-13.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format f2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-13.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
- list [catch {binary format f $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+ binary format f $a
+} -result "expected floating-point number but got \"1.6 3.4\""
test binary-13.18 {Tcl_BinaryObjCmd: format} bigEndian {
set a {1.6 3.4}
binary format f1 $a
@@ -481,12 +536,12 @@ test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian {
binary format f1 $a
} \xcd\xcc\xcc\x3f
-test binary-14.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format d} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-14.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format d blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format d
+} -result {not enough arguments for all format specifiers}
+test binary-14.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format d blat
+} -result {expected floating-point number but got "blat"}
test binary-14.3 {Tcl_BinaryObjCmd: format} {
binary format d0 1.6
} {}
@@ -514,13 +569,13 @@ test binary-14.10 {Tcl_BinaryObjCmd: format} bigEndian {
test binary-14.11 {Tcl_BinaryObjCmd: format} littleEndian {
binary format d2 {1.6 3.4 5.6}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
-test binary-14.14 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format d2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-14.15 {Tcl_BinaryObjCmd: format} {
+test binary-14.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format d2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-14.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
- list [catch {binary format d $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+ binary format d $a
+} -result "expected floating-point number but got \"1.6 3.4\""
test binary-14.16 {Tcl_BinaryObjCmd: format} bigEndian {
set a {1.6 3.4}
binary format d1 $a
@@ -534,9 +589,9 @@ test binary-14.18 {FormatNumber: Bug 1116542} {
set w
} 1.25
-test binary-15.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format ax*a "y" "z"} msg] $msg
-} {1 {cannot use "*" in format string with "x"}}
+test binary-15.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format ax*a "y" "z"
+} -result {cannot use "*" in format string with "x"}
test binary-15.2 {Tcl_BinaryObjCmd: format} {
binary format axa "y" "z"
} y\x00z
@@ -585,810 +640,840 @@ test binary-17.3 {Tcl_BinaryObjCmd: format} {
binary format {a* @0 a2 @* a*} "foobar" "ab" "blat"
} abobarblat
-test binary-18.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format u0a3 abc abd} msg] $msg
-} {1 {bad field specifier "u"}}
+test binary-18.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format u0a3 abc abd
+} -result {bad field specifier "u"}
-
-test binary-19.1 {Tcl_BinaryObjCmd: errors} {
- list [catch {binary s} msg] $msg
-} {1 {wrong # args: should be "binary scan value formatString ?varName ...?"}}
-test binary-19.2 {Tcl_BinaryObjCmd: errors} {
- list [catch {binary scan foo} msg] $msg
-} {1 {wrong # args: should be "binary scan value formatString ?varName ...?"}}
+test binary-19.1 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
+ binary s
+} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
+test binary-19.2 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
+ binary scan foo
+} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
test binary-19.3 {Tcl_BinaryObjCmd: scan} {
binary scan {} {}
} 0
-test binary-20.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc a} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-20.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-20.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc a
+} -result {not enough arguments for all format specifiers}
+test binary-20.2 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan abc a arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-20.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ binary scan abc a arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-20.3 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
set arg1 abc
list [binary scan abc a0 arg1] $arg1
-} {1 {}}
-test binary-20.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 {}}
+test binary-20.4 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc a* arg1] $arg1
-} {1 abc}
-test binary-20.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 abc}
+test binary-20.5 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc a5 arg1] [info exists arg1]
-} {0 0}
+} -result {0 0}
test binary-20.6 {Tcl_BinaryObjCmd: scan} {
set arg1 foo
list [binary scan abc a2 arg1] $arg1
} {1 ab}
-test binary-20.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+test binary-20.7 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+} -body {
list [binary scan abcdef a2a2 arg1 arg2] $arg1 $arg2
-} {2 ab cd}
-test binary-20.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {2 ab cd}
+test binary-20.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc a2 arg1(a)] $arg1(a)
-} {1 ab}
-test binary-20.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 ab}
+test binary-20.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc a arg1(a)] $arg1(a)
-} {1 a}
+} -result {1 a}
-test binary-21.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc A} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-21.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-21.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc A
+} -result {not enough arguments for all format specifiers}
+test binary-21.2 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan abc A arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-21.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ binary scan abc A arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-21.3 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
set arg1 abc
list [binary scan abc A0 arg1] $arg1
-} {1 {}}
-test binary-21.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 {}}
+test binary-21.4 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc A* arg1] $arg1
-} {1 abc}
-test binary-21.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 abc}
+test binary-21.5 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc A5 arg1] [info exists arg1]
-} {0 0}
+} -result {0 0}
test binary-21.6 {Tcl_BinaryObjCmd: scan} {
set arg1 foo
list [binary scan abc A2 arg1] $arg1
} {1 ab}
-test binary-21.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+test binary-21.7 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+} -body {
list [binary scan abcdef A2A2 arg1 arg2] $arg1 $arg2
-} {2 ab cd}
-test binary-21.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {2 ab cd}
+test binary-21.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc A2 arg1(a)] $arg1(a)
-} {1 ab}
-test binary-21.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 ab}
+test binary-21.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc A2 arg1(a)] $arg1(a)
-} {1 ab}
-test binary-21.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 ab}
+test binary-21.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan abc A arg1(a)] $arg1(a)
-} {1 a}
-test binary-21.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 a}
+test binary-21.11 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan "abc def \x00 " A* arg1] $arg1
-} {1 {abc def}}
-test binary-21.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+} -result {1 {abc def}}
+test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -body {
list [binary scan "abc def \x00ghi " A* arg1] $arg1
-} [list 1 "abc def \x00ghi"]
+} -result [list 1 "abc def \x00ghi"]
-test binary-22.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc b} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-22.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc b
+} -result {not enough arguments for all format specifiers}
test binary-22.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 b* arg1] $arg1
} {1 0100101011001010}
test binary-22.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 b arg1] $arg1
} {1 0}
test binary-22.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 b1 arg1] $arg1
} {1 0}
test binary-22.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 b0 arg1] $arg1
} {1 {}}
test binary-22.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 b5 arg1] $arg1
} {1 01001}
test binary-22.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 b8 arg1] $arg1
} {1 01001010}
test binary-22.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 b14 arg1] $arg1
} {1 01001010110010}
test binary-22.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 b14 arg1] $arg1
} {0 foo}
-test binary-22.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-22.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 b1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-22.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ binary scan \x52\x53 b1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-22.11 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
set arg1 foo
set arg2 bar
list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2
-} {2 11100 1110000110100000}
-
+} -result {2 11100 1110000110100000}
-test binary-23.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc B} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-23.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc B
+} -result {not enough arguments for all format specifiers}
test binary-23.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 B* arg1] $arg1
} {1 0101001001010011}
test binary-23.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 B arg1] $arg1
} {1 1}
test binary-23.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 B1 arg1] $arg1
} {1 1}
test binary-23.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 B0 arg1] $arg1
} {1 {}}
test binary-23.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 B5 arg1] $arg1
} {1 01010}
test binary-23.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 B8 arg1] $arg1
} {1 01010010}
test binary-23.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 B14 arg1] $arg1
} {1 01010010010100}
test binary-23.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 B14 arg1] $arg1
} {0 foo}
-test binary-23.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-23.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 B1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-23.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ binary scan \x52\x53 B1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-23.11 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2
-} {2 01110 1000011100000101}
+} -result {2 01110 1000011100000101}
-test binary-24.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc h} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-24.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc h
+} -result {not enough arguments for all format specifiers}
test binary-24.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 h* arg1] $arg1
} {1 253a}
test binary-24.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xc2\xa3 h arg1] $arg1
} {1 2}
test binary-24.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 h1 arg1] $arg1
} {1 2}
test binary-24.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 h0 arg1] $arg1
} {1 {}}
test binary-24.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xf2\x53 h2 arg1] $arg1
} {1 2f}
test binary-24.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 h3 arg1] $arg1
} {1 253}
test binary-24.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 h3 arg1] $arg1
} {0 foo}
-test binary-24.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-24.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 h1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-24.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ binary scan \x52\x53 h1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-24.10 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1 arg2
+} -body {
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2
-} {2 07 7850}
+} -result {2 07 7850}
-test binary-25.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc H} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-25.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc H
+} -result {not enough arguments for all format specifiers}
test binary-25.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 H* arg1] $arg1
} {1 52a3}
test binary-25.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xc2\xa3 H arg1] $arg1
} {1 c}
test binary-25.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x82\x53 H1 arg1] $arg1
} {1 8}
test binary-25.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 H0 arg1] $arg1
} {1 {}}
test binary-25.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xf2\x53 H2 arg1] $arg1
} {1 f2}
test binary-25.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\x53 H3 arg1] $arg1
} {1 525}
test binary-25.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 H3 arg1] $arg1
} {0 foo}
-test binary-25.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-25.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 H1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53 H1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-25.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 H2H* arg1 arg2] $arg1 $arg2
} {2 70 8705}
-test binary-26.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc c} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-26.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc c
+} -result {not enough arguments for all format specifiers}
test binary-26.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c* arg1] $arg1
} {1 {82 -93}}
test binary-26.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c arg1] $arg1
} {1 82}
test binary-26.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c1 arg1] $arg1
} {1 82}
test binary-26.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c0 arg1] $arg1
} {1 {}}
test binary-26.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-26.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xff c arg1] $arg1
} {1 -1}
test binary-26.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 c3 arg1] $arg1
} {0 foo}
-test binary-26.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-26.9 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 c1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53 c1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-26.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2
} {2 {112 -121} 5}
test binary-26.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 cu* arg1] $arg1
} {1 {82 163}}
test binary-26.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 cu arg1] $arg1
} {1 82}
test binary-26.13 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xff cu arg1] $arg1
} {1 255}
test binary-26.14 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x80 cuc arg1 arg2] $arg1 $arg2
} {2 128 -128}
test binary-26.15 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x80 ccu arg1 arg2] $arg1 $arg2
} {2 -128 128}
-test binary-27.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc s} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-27.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc s
+} -result {not enough arguments for all format specifiers}
test binary-27.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1
} {1 {-23726 21587}}
test binary-27.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 s arg1] $arg1
} {1 -23726}
test binary-27.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 s1 arg1] $arg1
} {1 -23726}
test binary-27.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 s0 arg1] $arg1
} {1 {}}
test binary-27.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1
} {1 {-23726 21587}}
test binary-27.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 s1 arg1] $arg1
} {0 foo}
-test binary-27.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-27.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 s1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53 s1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-27.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
test binary-27.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1
} {1 {41810 21587}}
test binary-27.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \xff\xff\xff\xff sus arg1 arg2] $arg1 $arg2
} {2 65535 -1}
test binary-27.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \xff\xff\xff\xff ssu arg1 arg2] $arg1 $arg2
} {2 -1 65535}
-test binary-28.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc S} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-28.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc S
+} -result {not enough arguments for all format specifiers}
test binary-28.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1
} {1 {21155 21332}}
test binary-28.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 S arg1] $arg1
} {1 21155}
test binary-28.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 S1 arg1] $arg1
} {1 21155}
test binary-28.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 S0 arg1] $arg1
} {1 {}}
test binary-28.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1
} {1 {21155 21332}}
test binary-28.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 S1 arg1] $arg1
} {0 foo}
-test binary-28.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-28.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 S1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53 S1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-28.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
test binary-28.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1
} {1 {21155 21332}}
test binary-28.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1
} {1 {41810 21587}}
-test binary-29.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc i} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-29.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc i
+} -result {not enough arguments for all format specifiers}
test binary-29.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1
} {1 1414767442}
test binary-29.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1
} {1 1414767442}
test binary-29.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53 i0 arg1] $arg1
} {1 {}}
test binary-29.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1
} {1 {1414767442 67305985}}
test binary-29.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 i1 arg1] $arg1
} {0 foo}
-test binary-29.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-29.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53\x53\x54 i1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53\x53\x54 i1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-29.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
test binary-29.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iui arg1 arg2] $arg1 $arg2
} {2 4294967295 -1}
test binary-29.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iiu arg1 arg2] $arg1 $arg2
} {2 -1 4294967295}
test binary-29.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 iuiu arg1 arg2] $arg1 $arg2
} {2 128 2147483648}
-test binary-30.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc I} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-30.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc I
+} -result {not enough arguments for all format specifiers}
test binary-30.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1
} {1 1386435412}
test binary-30.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1
} {1 1386435412}
test binary-30.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53 I0 arg1] $arg1
} {1 {}}
test binary-30.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1
} {1 {1386435412 16909060}}
test binary-30.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 I1 arg1] $arg1
} {0 foo}
-test binary-30.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-30.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53\x53\x54 I1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53\x53\x54 I1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-30.9 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
test binary-30.10 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IuI arg1 arg2] $arg1 $arg2
} {2 4294967295 -1}
test binary-30.11 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IIu arg1 arg2] $arg1 $arg2
} {2 -1 4294967295}
test binary-30.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2
} {2 2147483648 128}
-test binary-31.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc f} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-31.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc f
+} -result {not enough arguments for all format specifiers}
test binary-31.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f arg1] $arg1
} {1 1.600000023841858}
test binary-31.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f arg1] $arg1
} {1 1.600000023841858}
test binary-31.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1
} {1 1.600000023841858}
test binary-31.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1
} {1 1.600000023841858}
test binary-31.8 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1
} {1 {}}
test binary-31.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1
} {1 {}}
test binary-31.10 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.11 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-31.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 f1 arg1] $arg1
} {0 foo}
-test binary-31.13 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-31.13 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x3f\xcc\xcc\xcd f1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x3f\xcc\xcc\xcd f1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-31.14 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
-test binary-32.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc d} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-32.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc d
+} -result {not enough arguments for all format specifiers}
test binary-32.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d* arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d* arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d arg1] $arg1
} {1 1.6}
test binary-32.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d arg1] $arg1
} {1 1.6}
test binary-32.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1] $arg1
} {1 1.6}
test binary-32.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d1 arg1] $arg1
} {1 1.6}
test binary-32.8 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d0 arg1] $arg1
} {1 {}}
test binary-32.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d0 arg1] $arg1
} {1 {}}
test binary-32.10 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.11 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-32.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 d1 arg1] $arg1
} {0 foo}
-test binary-32.13 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-32.13 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-32.14 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 d2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-33.1 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2
} {2 ab def}
test binary-33.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3x*a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3x20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abc a3x20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-33.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x1a1 arg1] $arg1
} {1 b}
test binary-33.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x5a1 arg1] $arg1
} {1 f}
test binary-33.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x0a1 arg1] $arg1
} {1 a}
test binary-34.1 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
list [binary scan abcdefg a2Xa3 arg1 arg2] $arg1 $arg2
} {2 ab bcd}
test binary-34.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3X*a3 arg1 arg2] $arg1 $arg2
} {2 abc abc}
test binary-34.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3X20a3 arg1 arg2] $arg1 $arg2
} {2 abc abc}
test binary-34.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abc X20a3 arg1] $arg1
} {1 abc}
test binary-34.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x*X1a1 arg1] $arg1
} {1 f}
test binary-34.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x*X5a1 arg1] $arg1
} {1 b}
test binary-34.7 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x3X0a1 arg1] $arg1
} {1 d}
-test binary-35.1 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
- list [catch {binary scan abcdefg a2@a3 arg1 arg2} msg] $msg
-} {1 {missing count for "@" field specifier}}
+test binary-35.1 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+ unset -nocomplain arg2
+} -returnCodes error -body {
+ binary scan abcdefg a2@a3 arg1 arg2
+} -result {missing count for "@" field specifier}
test binary-35.2 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3@*a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-35.3 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
- catch {unset arg2}
+ unset -nocomplain arg1
+ unset -nocomplain arg2
set arg2 foo
list [binary scan abcdefg a3@20a3 arg1 arg2] $arg1 $arg2
} {1 abc foo}
test binary-35.4 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef @2a3 arg1] $arg1
} {1 cde}
test binary-35.5 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x*@1a1 arg1] $arg1
} {1 b}
test binary-35.6 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan abcdef x*@0a1 arg1] $arg1
} {1 a}
-test binary-36.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abcdef u0a3} msg] $msg
-} {1 {bad field specifier "u"}}
+test binary-36.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abcdef u0a3
+} -result {bad field specifier "u"}
-# GetFormatSpec is pretty thoroughly tested above, but there are a few
-# cases we should text explicitly
+# GetFormatSpec is pretty thoroughly tested above, but there are a few cases
+# we should text explicitly
test binary-37.1 {GetFormatSpec: whitespace} {
binary format "a3 a5 a3" foo barblat baz
@@ -1408,11 +1493,11 @@ test binary-37.5 {GetFormatSpec: whitespace} {
test binary-37.6 {GetFormatSpec: whitespace} {
binary format " a3 " foo
} foo
-test binary-37.7 {GetFormatSpec: numbers} {
- list [catch {binary scan abcdef "x-1" foo} msg] $msg
-} {1 {bad field specifier "-"}}
+test binary-37.7 {GetFormatSpec: numbers} -returnCodes error -body {
+ binary scan abcdef "x-1" foo
+} -result {bad field specifier "-"}
test binary-37.8 {GetFormatSpec: numbers} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan abcdef "a0x3" arg1] $arg1
} {1 {}}
@@ -1450,92 +1535,85 @@ test binary-38.8 {FormatNumber: word alignment} littleEndian {
} \x01\xcd\xcc\xcc\x3f
test binary-39.1 {ScanNumber: sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 c2 arg1] $arg1
} {1 {82 -93}}
test binary-39.2 {ScanNumber: sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1
} {1 {513 -32511 386 -32127}}
test binary-39.3 {ScanNumber: sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1
} {1 {258 385 -32255 -32382}}
test binary-39.4 {ScanNumber: sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 -2130640639}}
test binary-39.5 {ScanNumber: sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
} {1 {16843010 -2130640639 25297153 16876033 16843137}}
test binary-39.6 {ScanNumber: no sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 cu2 arg1] $arg1
} {1 {82 163}}
test binary-39.7 {ScanNumber: no sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 su4 arg1] $arg1
} {1 {513 33025 386 33409}}
test binary-39.8 {ScanNumber: no sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 Su4 arg1] $arg1
} {1 {258 385 33281 33154}}
test binary-39.9 {ScanNumber: no sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 iu5 arg1] $arg1
} {1 {33620225 16843137 16876033 25297153 2164326657}}
test binary-39.10 {ScanNumber: no sign extension} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 Iu5 arg1] $arg1
} {1 {16843010 2164326657 25297153 16876033 16843137}}
-test binary-40.3 {ScanNumber: NaN} \
- -body {
- catch {unset arg1}
- list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
- } \
- -match glob \
- -result {1 -NaN*}
-
-test binary-40.4 {ScanNumber: NaN} \
- -body {
- catch {unset arg1}
- list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1
- } \
- -match glob \
- -result {1 -NaN*}
+test binary-40.3 {ScanNumber: NaN} -body {
+ unset -nocomplain arg1
+ list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
+} -match glob -result {1 -NaN*}
+test binary-40.4 {ScanNumber: NaN} -body {
+ unset -nocomplain arg1
+ list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1
+} -match glob -result {1 -NaN*}
test binary-41.1 {ScanNumber: word alignment} {
- catch {unset arg1; unset arg2}
+ unset -nocomplain arg1; unset arg2
list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.2 {ScanNumber: word alignment} {
- catch {unset arg1; unset arg2}
+ unset -nocomplain arg1; unset arg2
list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.3 {ScanNumber: word alignment} {
- catch {unset arg1; unset arg2}
+ unset -nocomplain arg1; unset arg2
list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.4 {ScanNumber: word alignment} {
- catch {unset arg1; unset arg2}
+ unset -nocomplain arg1; unset arg2
list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
} {2 1 1}
test binary-41.5 {ScanNumber: word alignment} bigEndian {
- catch {unset arg1; unset arg2}
+ unset -nocomplain arg1; unset arg2
list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2
} {2 1 1.600000023841858}
test binary-41.6 {ScanNumber: word alignment} littleEndian {
- catch {unset arg1; unset arg2}
+ unset -nocomplain arg1; unset arg2
list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2
} {2 1 1.600000023841858}
test binary-41.7 {ScanNumber: word alignment} bigEndian {
- catch {unset arg1; unset arg2}
+ unset -nocomplain arg1; unset arg2
list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2
} {2 1 1.6}
test binary-41.8 {ScanNumber: word alignment} littleEndian {
- catch {unset arg1; unset arg2}
+ unset -nocomplain arg1; unset arg2
list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
} {2 1 1.6}
@@ -1568,23 +1646,23 @@ test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
set x
} 6442450944
test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
} {1 -9223372036854775808}
test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
} {1 9223372036854775808}
test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}
test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}
@@ -1620,22 +1698,22 @@ test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
} "1 \u00a4 \u20ac"
test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} {
- # This test is only reliable when memory debugging is turned on,
- # but without even memory debugging it should still generate the
- # expected answers and might therefore still pick up memory corruption
- # caused by [Bug 851747].
+ # This test is only reliable when memory debugging is turned on, but
+ # without even memory debugging it should still generate the expected
+ # answers and might therefore still pick up memory corruption caused by
+ # [Bug 851747].
list [binary scan aba ccc x x x] $x
} {3 97}
### TIP#129: endian specifiers ----
# format t
-test binary-48.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format t} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-48.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format t blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-48.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format t
+} -result {not enough arguments for all format specifiers}
+test binary-48.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format t blat
+} -result {expected integer but got "blat"}
test binary-48.3 {Tcl_BinaryObjCmd: format} {
binary format S0 0x50
} {}
@@ -1663,10 +1741,10 @@ test binary-48.10 {Tcl_BinaryObjCmd: format} bigEndian {
test binary-48.11 {Tcl_BinaryObjCmd: format} littleEndian {
binary format t2 {0x50 0x52}
} P\x00R\x00
-test binary-48.12 {Tcl_BinaryObjCmd: format} bigEndian {
+test binary-48.12 {Tcl_BinaryObjCmd: format} bigEndian {
binary format t* {0x5051 0x52}
} PQ\x00R
-test binary-48.13 {Tcl_BinaryObjCmd: format} littleEndian {
+test binary-48.13 {Tcl_BinaryObjCmd: format} littleEndian {
binary format t* {0x5051 0x52}
} QPR\x00
test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian {
@@ -1675,13 +1753,13 @@ test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian {
test binary-48.15 {Tcl_BinaryObjCmd: format} littleEndian {
binary format t2 {0x50 0x52 0x53} 0x54
} P\x00R\x00
-test binary-48.16 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format t2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-48.17 {Tcl_BinaryObjCmd: format} {
+test binary-48.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format t2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-48.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format t $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format t $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-48.18 {Tcl_BinaryObjCmd: format} bigEndian {
set a {0x50 0x51}
binary format t1 $a
@@ -1692,12 +1770,12 @@ test binary-48.19 {Tcl_BinaryObjCmd: format} littleEndian {
} P\x00
# format n
-test binary-49.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format n} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-49.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format n blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-49.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format n
+} -result {not enough arguments for all format specifiers}
+test binary-49.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format n blat
+} -result {expected integer but got "blat"}
test binary-49.3 {Tcl_BinaryObjCmd: format} {
binary format n0 0x50
} {}
@@ -1722,13 +1800,13 @@ test binary-49.9 {Tcl_BinaryObjCmd: format} littleEndian {
test binary-49.10 {Tcl_BinaryObjCmd: format} littleEndian {
binary format n* {0x50515253 0x52}
} SRQPR\x00\x00\x00
-test binary-49.11 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format n2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-49.12 {Tcl_BinaryObjCmd: format} {
+test binary-49.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format n2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-49.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {0x50 0x51}
- list [catch {binary format n $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+ binary format n $a
+} -result "expected integer but got \"0x50 0x51\""
test binary-49.13 {Tcl_BinaryObjCmd: format} littleEndian {
set a {0x50 0x51}
binary format n1 $a
@@ -1771,14 +1849,13 @@ test binary-50.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
set x
} 6442450944
-
# format Q/q
-test binary-51.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format Q} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-51.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format q blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-51.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format Q
+} -result {not enough arguments for all format specifiers}
+test binary-51.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format q blat
+} -result {expected floating-point number but got "blat"}
test binary-51.3 {Tcl_BinaryObjCmd: format} {
binary format q0 1.6
} {}
@@ -1806,13 +1883,13 @@ test binary-51.10 {Tcl_BinaryObjCmd: format} {} {
test binary-51.11 {Tcl_BinaryObjCmd: format} {} {
binary format q2 {1.6 3.4 5.6}
} \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
-test binary-51.14 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format q2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-51.15 {Tcl_BinaryObjCmd: format} {
+test binary-51.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format q2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-51.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
- list [catch {binary format q $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+ binary format q $a
+} -result "expected floating-point number but got \"1.6 3.4\""
test binary-51.16 {Tcl_BinaryObjCmd: format} {} {
set a {1.6 3.4}
binary format Q1 $a
@@ -1823,12 +1900,12 @@ test binary-51.17 {Tcl_BinaryObjCmd: format} {} {
} \x9a\x99\x99\x99\x99\x99\xf9\x3f
# format R/r
-test binary-53.1 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format r} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-53.2 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format r blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-53.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format r
+} -result {not enough arguments for all format specifiers}
+test binary-53.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format r blat
+} -result {expected floating-point number but got "blat"}
test binary-53.3 {Tcl_BinaryObjCmd: format} {
binary format f0 1.6
} {}
@@ -1868,13 +1945,13 @@ test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} {
binary format r -3.402825e-100
} \x00\x00\x00\x80
-test binary-53.16 {Tcl_BinaryObjCmd: format} {
- list [catch {binary format r2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-53.17 {Tcl_BinaryObjCmd: format} {
+test binary-53.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+ binary format r2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-53.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
set a {1.6 3.4}
- list [catch {binary format r $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+ binary format r $a
+} -result "expected floating-point number but got \"1.6 3.4\""
test binary-53.18 {Tcl_BinaryObjCmd: format} {} {
set a {1.6 3.4}
binary format R1 $a
@@ -1885,346 +1962,352 @@ test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
} \xcd\xcc\xcc\x3f
# scan t (s)
-test binary-54.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc t} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc t
+} -result {not enough arguments for all format specifiers}
test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
} {1 {-23726 21587}}
test binary-54.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
} {1 -23726}
test binary-54.4 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 t1 arg1] $arg1
} {1 -23726}
test binary-54.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3 t0 arg1] $arg1
} {1 {}}
test binary-54.6 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
} {1 {-23726 21587}}
test binary-54.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
-test binary-54.8 {Tcl_BinaryObjCmd: scan} {} {
- catch {unset arg1}
+test binary-54.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 t1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x52\x53 t1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {-23726 21587} 5}
-test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x00\x80\x00\x80 tut arg1 arg2] $arg1 $arg2
} {2 32768 -32768}
-test binary-54.11 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+test binary-54.11 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x00\x80\x00\x80 ttu arg1 arg2] $arg1 $arg2
} {2 -32768 32768}
# scan t (b)
-test binary-55.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc t} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc t
+} -result {not enough arguments for all format specifiers}
+test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
} {1 {21155 21332}}
-test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
} {1 21155}
-test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3 t1 arg1] $arg1
} {1 21155}
-test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3 t0 arg1] $arg1
} {1 {}}
-test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
} {1 {21155 21332}}
-test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 t1 arg1] $arg1
} {0 foo}
-test binary-55.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-55.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53 t1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ binary scan \x52\x53 t1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
} {2 {21155 21332} 5}
-test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x00\x80\x00 tut arg1 arg2] $arg1 $arg2
} {2 32768 -32768}
-test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x00\x80\x00 ttu arg1 arg2] $arg1 $arg2
} {2 -32768 32768}
# scan n (s)
-test binary-56.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc n} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-56.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc n
+} -result {not enough arguments for all format specifiers}
test binary-56.2 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
} {1 {1414767442 67305985}}
-test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
} {1 1414767442}
-test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
} {1 1414767442}
-test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53 n0 arg1] $arg1
} {1 {}}
-test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
} {1 {1414767442 67305985}}
-test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
-test binary-56.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-56.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53\x53\x54 n1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ binary scan \x52\x53\x53\x54 n1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1414767442 67305985} 5}
-test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
} {2 128 128}
-test binary-56.11 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+test binary-56.11 {Tcl_BinaryObjCmd: scan} littleEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
} {2 2147483648 -2147483648}
# scan n (b)
-test binary-57.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc n} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc n
+} -result {not enough arguments for all format specifiers}
+test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
} {1 {1386435412 16909060}}
-test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
} {1 1386435412}
-test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
} {1 1386435412}
-test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53 n0 arg1] $arg1
} {1 {}}
-test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
} {1 {1386435412 16909060}}
-test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 n1 arg1] $arg1
} {0 foo}
-test binary-57.8 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-57.8 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x52\x53\x53\x54 n1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ binary scan \x52\x53\x53\x54 n1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
} {2 {1386435412 16909060} 5}
-test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
} {2 2147483648 -2147483648}
-test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian {
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
} {2 128 128}
# scan Q/q
-test binary-58.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc q} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-58.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc q
+} -result {not enough arguments for all format specifiers}
test binary-58.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q* arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q arg1] $arg1
} {1 1.6}
test binary-58.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q arg1] $arg1
} {1 1.6}
test binary-58.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q1 arg1] $arg1
} {1 1.6}
test binary-58.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q1 arg1] $arg1
} {1 1.6}
test binary-58.8 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q0 arg1] $arg1
} {1 {}}
test binary-58.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q0 arg1] $arg1
} {1 {}}
test binary-58.10 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.11 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q2 arg1] $arg1
} {1 {1.6 3.4}}
test binary-58.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 q1 arg1] $arg1
} {0 foo}
-test binary-58.13 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-58.13 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-58.14 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
test binary-58.15 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 q2c* arg1 arg2] $arg1 $arg2
} {2 {1.6 3.4} 5}
# scan R/r
-test binary-59.1 {Tcl_BinaryObjCmd: scan} {
- list [catch {binary scan abc r} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-59.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+ binary scan abc r
+} -result {not enough arguments for all format specifiers}
test binary-59.2 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.3 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r* arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.4 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R arg1] $arg1
} {1 1.600000023841858}
test binary-59.5 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r arg1] $arg1
} {1 1.600000023841858}
test binary-59.6 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd R1 arg1] $arg1
} {1 1.600000023841858}
test binary-59.7 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f r1 arg1] $arg1
} {1 1.600000023841858}
test binary-59.8 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd R0 arg1] $arg1
} {1 {}}
test binary-59.9 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f r0 arg1] $arg1
} {1 {}}
test binary-59.10 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.11 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1}
+ unset -nocomplain arg1
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r2 arg1] $arg1
} {1 {1.600000023841858 3.4000000953674316}}
test binary-59.12 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+ unset -nocomplain arg1
set arg1 foo
list [binary scan \x52 r1 arg1] $arg1
} {0 foo}
-test binary-59.13 {Tcl_BinaryObjCmd: scan} {
- catch {unset arg1}
+test binary-59.13 {Tcl_BinaryObjCmd: scan} -setup {
+ unset -nocomplain arg1
+} -returnCodes error -body {
set arg1 1
- list [catch {binary scan \x3f\xcc\xcc\xcd r1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+ binary scan \x3f\xcc\xcc\xcd r1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
test binary-59.14 {Tcl_BinaryObjCmd: scan} bigEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 R2c* arg1 arg2] $arg1 $arg2
} {2 {1.600000023841858 3.4000000953674316} 5}
test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian {
- catch {unset arg1 arg2}
+ unset -nocomplain arg1 arg2
set arg1 foo
set arg2 bar
list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2
@@ -2245,7 +2328,7 @@ test binary-61.2 {Tcl_BinaryObjCmd: scan wide int} littleEndian {
binary scan lcTolleH m x
set x
} 5216694956358656876
-test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian {
+test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian {
binary scan [binary format w [expr {wide(3) << 31}]] m x
set x
} 6442450944
@@ -2254,65 +2337,6 @@ test binary-61.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
set x
} 6442450944
-# Big test for correct ordering of data in [expr]
-
-proc testIEEE {} {
- variable ieeeValues
- binary scan [binary format dd -1.0 1.0] c* c
- switch -exact -- $c {
- {0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
- # little endian
- binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
- ieeeValues(-Infinity)
- binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
- ieeeValues(-Normal)
- binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
- ieeeValues(-Subnormal)
- binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
- ieeeValues(-0)
- binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(+0)
- binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
- ieeeValues(+Subnormal)
- binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
- ieeeValues(+Normal)
- binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
- ieeeValues(+Infinity)
- binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
- ieeeValues(NaN)
- set ieeeValues(littleEndian) 1
- return 1
- }
- {-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
- binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(-Infinity)
- binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(-Normal)
- binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(-Subnormal)
- binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(-0)
- binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(+0)
- binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(+Subnormal)
- binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(+Normal)
- binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(+Infinity)
- binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
- ieeeValues(NaN)
- set ieeeValues(littleEndian) 0
- return 1
- }
- default {
- return 0
- }
- }
-}
-
-testConstraint ieeeFloatingPoint [testIEEE]
-
# scan/format infinities
test binary-62.1 {infinity} ieeeFloatingPoint {
@@ -2358,20 +2382,15 @@ test binary-63.4 {NaN} ieeeFloatingPoint {
binary scan [binary format q {NaN( 3123456789aBc)}] w w
format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
} 0x7ff3123456789abc
-test binary-64.1 {NaN} \
- -constraints ieeeFloatingPoint \
- -body {
- binary scan [binary format w 0x7ff8000000000000] q d
- set d
- } \
- -match glob -result NaN*
-test binary-64.2 {NaN} \
- -constraints ieeeFloatingPoint \
- -body {
- binary scan [binary format w 0x7ff0123456789aBc] q d
- set d
- } \
- -match glob -result NaN(*123456789abc)
+
+test binary-64.1 {NaN} -constraints ieeeFloatingPoint -body {
+ binary scan [binary format w 0x7ff8000000000000] q d
+ set d
+} -match glob -result NaN*
+test binary-64.2 {NaN} -constraints ieeeFloatingPoint -body {
+ binary scan [binary format w 0x7ff0123456789aBc] q d
+ set d
+} -match glob -result NaN(*123456789abc)
test binary-65.1 {largest significand} ieeeFloatingPoint {
binary scan [binary format w 0x3fcfffffffffffff] q d
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 94f422a..73a8819 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdAH.test,v 1.61 2008/09/08 10:49:04 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.62 2008/09/10 13:50:04 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -968,9 +968,8 @@ test cmdAH-20.2 {Tcl_FileObjCmd: atime} -setup {
[expr {[file atime $gorpfile] == $stat(atime)}]
} -result {1 1}
test cmdAH-20.3 {Tcl_FileObjCmd: atime} {
- string tolower [list [catch {file atime _bogus_} msg] \
- $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+ list [catch {file atime _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
test cmdAH-20.4 {Tcl_FileObjCmd: atime} -returnCodes error -body {
file atime $file notint
} -result {expected integer but got "notint"}
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index cc1546e..ca9377a 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -1,14 +1,14 @@
-# This file contains a collection of tests for the procedures in the
-# file tclCmdIL.c. Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
+# This file contains a collection of tests for the procedures in the file
+# tclCmdIL.c. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
#
# Copyright (c) 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.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdIL.test,v 1.39 2008/07/13 23:15:21 nijtmans Exp $
+# RCS: @(#) $Id: cmdIL.test,v 1.40 2008/09/10 13:50:05 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -17,22 +17,23 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
+testConstraint testobj [llength [info commands testobj]]
-test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
- list [catch {lsort} msg] $msg
-} {1 {wrong # args: should be "lsort ?-option value ...? list"}}
-test cmdIL-1.2 {Tcl_LsortObjCmd procedure} {
- list [catch {lsort -foo {1 3 2 5}} msg] $msg
-} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, or -unique}}
+test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
+ lsort
+} -result {wrong # args: should be "lsort ?-option value ...? list"}
+test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
+ lsort -foo {1 3 2 5}
+} -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, or -unique}
test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} {
lsort {d e c b a \{ d35 d300}
} {a b c d d300 d35 e \{}
test cmdIL-1.4 {Tcl_LsortObjCmd procedure, -ascii option} {
lsort -integer -ascii {d e c b a d35 d300}
} {a b c d d300 d35 e}
-test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} {
- list [catch {lsort -command {1 3 2 5}} msg] $msg
-} {1 {"-command" option must be followed by comparison command}}
+test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} -body {
+ lsort -command {1 3 2 5}
+} -returnCodes error -result {"-command" option must be followed by comparison command}
test cmdIL-1.6 {Tcl_LsortObjCmd procedure, -command option} -setup {
proc cmp {a b} {
expr {[string match x* $b] - [string match x* $a]}
@@ -54,12 +55,12 @@ test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -dictionary option} {
test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -increasing option} {
lsort -decreasing -increasing {d e c b a d35 d300}
} {a b c d d300 d35 e}
-test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} {
- list [catch {lsort -index {1 3 2 5}} msg] $msg
-} {1 {"-index" option must be followed by list index}}
-test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} {
- list [catch {lsort -index foo {1 3 2 5}} msg] $msg
-} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}}
+test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} -body {
+ lsort -index {1 3 2 5}
+} -returnCodes error -result {"-index" option must be followed by list index}
+test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} -body {
+ lsort -index foo {1 3 2 5}
+} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} {
lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
} {1 {2 25} {3 16 42} {10 20 50 100}}
@@ -69,15 +70,15 @@ test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -index option} {
test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} {
lsort -integer {24 6 300 18}
} {6 18 24 300}
-test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} {
- list [catch {lsort -integer {1 3 2.4}} msg] $msg
-} {1 {expected integer but got "2.4"}}
+test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} -body {
+ lsort -integer {1 3 2.4}
+} -returnCodes error -result {expected integer but got "2.4"}
test cmdIL-1.17 {Tcl_LsortObjCmd procedure, -real option} {
lsort -real {24.2 6e3 150e-1}
} {150e-1 24.2 6e3}
-test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} {
- list [catch {lsort "1 2 3 \{ 4"} msg] $msg
-} {1 {unmatched open brace in list}}
+test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} -body {
+ lsort "1 2 3 \{ 4"
+} -returnCodes error -result {unmatched open brace in list}
test cmdIL-1.19 {Tcl_LsortObjCmd procedure, empty list} {
lsort {}
} {}
@@ -93,22 +94,21 @@ test cmdIL-1.24 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup
proc testcmp {a b} {return [string compare $a $b]}
} -body {
set l [list [list a b] [list c d]]
- list [catch {lsort -command testcmp -index 1 $l} msg] $msg
+ lsort -command testcmp -index 1 $l
} -cleanup {
rename testcmp ""
-} -result [list 0 [list [list a b] [list c d]]]
+} -result [list [list a b] [list c d]]
test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup {
catch {rename 1 ""}
proc testcmp {a b} {return [string compare $a $b]}
} -body {
set l [list [list a b] [list c d]]
- list [catch {lsort -index 1 -command testcmp $l} msg] $msg
+ lsort -index 1 -command testcmp $l
} -cleanup {
rename testcmp ""
-} -result [list 0 [list [list a b] [list c d]]]
-# Note that the required order only exists in the end-1'th element;
-# indexing using the end element or any fixed offset from the start
-# will not work...
+} -result [list [list a b] [list c d]]
+# Note that the required order only exists in the end-1'th element; indexing
+# using the end element or any fixed offset from the start will not work...
test cmdIL-1.26 {Tcl_LsortObjCmd procedure, offset indexing from end} {
lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
} {{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}}
@@ -123,8 +123,8 @@ test cmdIL-1.29 {Tcl_LsortObjCmd procedure, loss of list rep during sorting} {
string length [lsort -command {apply {args {string length $::l}}} $l]
} 5
-# Can't think of any good tests for the MergeSort and MergeLists
-# procedures, except a bunch of random lists to sort.
+# Can't think of any good tests for the MergeSort and MergeLists procedures,
+# except a bunch of random lists to sort.
test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup {
set result {}
@@ -154,34 +154,30 @@ test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup {
rename rand ""
} -result {}
-test cmdIL-3.1 {SortCompare procedure, skip comparisons after error} -setup {
- proc cmp {a b} {
- global x
- incr x
- error "error #$x"
- }
-} -body {
- set x 0
- list [catch {lsort -integer -command cmp {48 6 28 190 16 2 3 6 1}} msg] \
- $msg $x
-} -cleanup {
- rename cmp ""
+test cmdIL-3.1 {SortCompare procedure, skip comparisons after error} -body {
+ set ::x 0
+ list [catch {
+ lsort -integer -command {apply {{a b} {
+ incr ::x
+ error "error #$::x"
+ }}} {48 6 28 190 16 2 3 6 1}
+ } msg] $msg $::x
} -result {1 {error #1} 1}
-test cmdIL-3.2 {SortCompare procedure, -index option} {
- list [catch {lsort -integer -index 2 "\\\{ {30 40 50}"} msg] $msg
-} {1 {unmatched open brace in list}}
-test cmdIL-3.3 {SortCompare procedure, -index option} {
- list [catch {lsort -integer -index 2 {{20 10} {15 30 40}}} msg] $msg
-} {1 {element 2 missing from sublist "20 10"}}
-test cmdIL-3.4 {SortCompare procedure, -index option} {
- list [catch {lsort -integer -index 2 "{a b c} \\\{"} msg] $msg
-} {1 {expected integer but got "c"}}
-test cmdIL-3.4.1 {SortCompare procedure, -index option} {
- list [catch {lsort -integer -index 2 "{1 2 3} \\\{"} msg] $msg
-} {1 {unmatched open brace in list}}
-test cmdIL-3.5 {SortCompare procedure, -index option} {
- list [catch {lsort -integer -index 2 {{20 10 13} {15}}} msg] $msg
-} {1 {element 2 missing from sublist "15"}}
+test cmdIL-3.2 {SortCompare procedure, -index option} -body {
+ lsort -integer -index 2 "\\\{ {30 40 50}"
+} -returnCodes error -result {unmatched open brace in list}
+test cmdIL-3.3 {SortCompare procedure, -index option} -body {
+ lsort -integer -index 2 {{20 10} {15 30 40}}
+} -returnCodes error -result {element 2 missing from sublist "20 10"}
+test cmdIL-3.4 {SortCompare procedure, -index option} -body {
+ lsort -integer -index 2 "{a b c} \\\{"
+} -returnCodes error -result {expected integer but got "c"}
+test cmdIL-3.4.1 {SortCompare procedure, -index option} -body {
+ lsort -integer -index 2 "{1 2 3} \\\{"
+} -returnCodes error -result {unmatched open brace in list}
+test cmdIL-3.5 {SortCompare procedure, -index option} -body {
+ lsort -integer -index 2 {{20 10 13} {15}}
+} -returnCodes error -result {element 2 missing from sublist "15"}
test cmdIL-3.6 {SortCompare procedure, -index option} {
lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}}
} {{3 25 20} {2 5 25} {1 15 30}}
@@ -191,21 +187,21 @@ test cmdIL-3.7 {SortCompare procedure, -ascii option} {
test cmdIL-3.8 {SortCompare procedure, -dictionary option} {
lsort -dictionary {d e c b a d35 d300 100 20}
} {20 100 a b c d d35 d300 e}
-test cmdIL-3.9 {SortCompare procedure, -integer option} {
- list [catch {lsort -integer {x 3}} msg] $msg
-} {1 {expected integer but got "x"}}
-test cmdIL-3.10 {SortCompare procedure, -integer option} {
- list [catch {lsort -integer {3 q}} msg] $msg
-} {1 {expected integer but got "q"}}
+test cmdIL-3.9 {SortCompare procedure, -integer option} -body {
+ lsort -integer {x 3}
+} -returnCodes error -result {expected integer but got "x"}
+test cmdIL-3.10 {SortCompare procedure, -integer option} -body {
+ lsort -integer {3 q}
+} -returnCodes error -result {expected integer but got "q"}
test cmdIL-3.11 {SortCompare procedure, -integer option} {
lsort -integer {35 21 0x20 30 0o23 100 8}
} {8 0o23 21 30 0x20 35 100}
-test cmdIL-3.12 {SortCompare procedure, -real option} {
- list [catch {lsort -real {6...4 3}} msg] $msg
-} {1 {expected floating-point number but got "6...4"}}
-test cmdIL-3.13 {SortCompare procedure, -real option} {
- list [catch {lsort -real {3 1x7}} msg] $msg
-} {1 {expected floating-point number but got "1x7"}}
+test cmdIL-3.12 {SortCompare procedure, -real option} -body {
+ lsort -real {6...4 3}
+} -returnCodes error -result {expected floating-point number but got "6...4"}
+test cmdIL-3.13 {SortCompare procedure, -real option} -body {
+ lsort -real {3 1x7}
+} -returnCodes error -result {expected floating-point number but got "1x7"}
test cmdIL-3.14 {SortCompare procedure, -real option} {
lsort -real {24 2.5e01 16.7 85e-1 10.004}
} {85e-1 10.004 16.7 24 2.5e01}
@@ -237,10 +233,10 @@ test cmdIL-3.17 {SortCompare procedure, -command option, non-integer result} -bo
proc cmp {a b} {
return foow
}
- list [catch {lsort -command cmp {48 6}} msg] $msg
-} -cleanup {
+ lsort -command cmp {48 6}
+} -returnCodes error -cleanup {
rename cmp ""
-} -result {1 {-compare command returned non-integer result}}
+} -result {-compare command returned non-integer result}
test cmdIL-3.18 {SortCompare procedure, -command option} -body {
proc cmp {a b} {
expr {$b - $a}
@@ -440,108 +436,71 @@ test cmdIL-5.5 {lsort with list style index and sharing} -body {
}
# Compiled version
-test cmdIL-6.1 {lassign command syntax} -body {
- proc testLassign {} {
- lassign
- }
- testLassign
-} -returnCodes 1 -cleanup {
- rename testLassign {}
+test cmdIL-6.1 {lassign command syntax} -returnCodes error -body {
+ apply {{} { lassign }}
} -result {wrong # args: should be "lassign list varName ?varName ...?"}
-test cmdIL-6.2 {lassign command syntax} -body {
- proc testLassign {} {
- lassign x
- }
- testLassign
-} -returnCodes 1 -cleanup {
- rename testLassign {}
+test cmdIL-6.2 {lassign command syntax} -returnCodes error -body {
+ apply {{} { lassign x }}
} -result {wrong # args: should be "lassign list varName ?varName ...?"}
test cmdIL-6.3 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
list [lassign a x] $x
- }
- testLassign
-} -result {{} a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a}
test cmdIL-6.4 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
set y FAIL
list [lassign a x y] $x $y
- }
- testLassign
-} -result {{} a {}} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a {}}
test cmdIL-6.5 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
set y FAIL
list [lassign {a b} x y] $x $y
- }
- testLassign
-} -result {{} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a b}
test cmdIL-6.6 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
set y FAIL
list [lassign {a b c} x y] $x $y
- }
- testLassign
-} -result {c a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {c a b}
test cmdIL-6.7 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
set y FAIL
list [lassign {a b c d} x y] $x $y
- }
- testLassign
-} -result {{c d} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{c d} a b}
test cmdIL-6.8 {lassign command - list format error} -body {
- proc testLassign {} {
+ apply {{} {
set x FAIL
set y FAIL
list [catch {lassign {a {b}c d} x y} msg] $msg $x $y
- }
- testLassign
-} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL}
test cmdIL-6.9 {lassign command - assignment to arrays} -body {
- proc testLassign {} {
+ apply {{} {
list [lassign {a b} x(x)] $x(x)
- }
- testLassign
-} -result {b a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {b a}
test cmdIL-6.10 {lassign command - variable update error} -body {
- proc testLassign {} {
+ apply {{} {
set x(x) {}
lassign a x
- }
- testLassign
-} -returnCodes 1 -result {can't set "x": variable is array} -cleanup {
- rename testLassign {}
-}
+ }}
+} -returnCodes error -result {can't set "x": variable is array}
test cmdIL-6.11 {lassign command - variable update error} -body {
- proc testLassign {} {
+ apply {{} {
set x(x) {}
set y FAIL
list [catch {lassign a y x} msg] $msg $y
- }
- testLassign
-} -result {1 {can't set "x": variable is array} a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {1 {can't set "x": variable is array} a}
test cmdIL-6.12 {lassign command - memory leak testing} -setup {
unset -nocomplain x y
set x(x) {}
@@ -570,119 +529,86 @@ test cmdIL-6.12 {lassign command - memory leak testing} -setup {
rename stress {}
}
# Force non-compiled version
-test cmdIL-6.13 {lassign command syntax} -body {
- proc testLassign {} {
+test cmdIL-6.13 {lassign command syntax} -returnCodes error -body {
+ apply {{} {
set lassign lassign
$lassign
- }
- testLassign
-} -returnCodes 1 -cleanup {
- rename testLassign {}
+ }}
} -result {wrong # args: should be "lassign list varName ?varName ...?"}
-test cmdIL-6.14 {lassign command syntax} -body {
- proc testLassign {} {
+test cmdIL-6.14 {lassign command syntax} -returnCodes error -body {
+ apply {{} {
set lassign lassign
$lassign x
- }
- testLassign
-} -returnCodes 1 -cleanup {
- rename testLassign {}
+ }}
} -result {wrong # args: should be "lassign list varName ?varName ...?"}
test cmdIL-6.15 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
list [$lassign a x] $x
- }
- testLassign
-} -result {{} a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a}
test cmdIL-6.16 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
set y FAIL
list [$lassign a x y] $x $y
- }
- testLassign
-} -result {{} a {}} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a {}}
test cmdIL-6.17 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
set y FAIL
list [$lassign {a b} x y] $x $y
- }
- testLassign
-} -result {{} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{} a b}
test cmdIL-6.18 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
set y FAIL
list [$lassign {a b c} x y] $x $y
- }
- testLassign
-} -result {c a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {c a b}
test cmdIL-6.19 {lassign command} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
set y FAIL
list [$lassign {a b c d} x y] $x $y
- }
- testLassign
-} -result {{c d} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {{c d} a b}
test cmdIL-6.20 {lassign command - list format error} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x FAIL
set y FAIL
list [catch {$lassign {a {b}c d} x y} msg] $msg $x $y
- }
- testLassign
-} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL}
test cmdIL-6.21 {lassign command - assignment to arrays} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
list [$lassign {a b} x(x)] $x(x)
- }
- testLassign
-} -result {b a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {b a}
test cmdIL-6.22 {lassign command - variable update error} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x(x) {}
$lassign a x
- }
- testLassign
-} -returnCodes 1 -result {can't set "x": variable is array} -cleanup {
- rename testLassign {}
-}
+ }}
+} -returnCodes 1 -result {can't set "x": variable is array}
test cmdIL-6.23 {lassign command - variable update error} -body {
- proc testLassign {} {
+ apply {{} {
set lassign lassign
set x(x) {}
set y FAIL
list [catch {$lassign a y x} msg] $msg $y
- }
- testLassign
-} -result {1 {can't set "x": variable is array} a} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {1 {can't set "x": variable is array} a}
test cmdIL-6.24 {lassign command - memory leak testing} -setup {
set x(x) {}
set y FAIL
@@ -712,24 +638,18 @@ test cmdIL-6.24 {lassign command - memory leak testing} -setup {
}
# Assorted shimmering problems
test cmdIL-6.25 {lassign command - shimmering protection} -body {
- proc testLassign {} {
+ apply {{} {
set x {a b c}
list [lassign $x $x y] $x [set $x] $y
- }
- testLassign
-} -result {c {a b c} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {c {a b c} a b}
test cmdIL-6.26 {lassign command - shimmering protection} -body {
- proc testLassign {} {
+ apply {{} {
set x {a b c}
set lassign lassign
list [$lassign $x $x y] $x [set $x] $y
- }
- testLassign
-} -result {c {a b c} a b} -cleanup {
- rename testLassign {}
-}
+ }}
+} -result {c {a b c} a b}
test cmdIL-7.1 {lreverse command} -body {
lreverse
@@ -753,8 +673,6 @@ test cmdIL-7.6 {lreverse command - unshared object [Bug 1672585]} {
test cmdIL-7.7 {lreverse command - empty object [Bug 1876793]} {
lreverse [list]
} {}
-
-testConstraint testobj [llength [info commands testobj]]
test cmdIL-7.8 {lreverse command - shared intrep [Bug 1675044]} -setup {
teststringobj set 1 {1 2 3}
testobj convert 1 list
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 85b7bde..ae96301 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -1,17 +1,17 @@
# The tests in this file cover the procedures in tclCmdMZ.c.
#
-# 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.
+# 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 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.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdMZ.test,v 1.25 2006/10/09 19:15:44 msofer Exp $
+# RCS: @(#) $Id: cmdMZ.test,v 1.26 2008/09/10 13:50:05 dkf Exp $
if {[catch {package require tcltest 2.1}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
@@ -26,49 +26,64 @@ namespace eval ::tcl::test::cmdMZ {
namespace import ::tcltest::temporaryDirectory
namespace import ::tcltest::test
+ proc ListGlobMatch {expected actual} {
+ if {[llength $expected] != [llength $actual]} {
+ return 0
+ }
+ foreach e $expected a $actual {
+ if {![string match $e $a]} {
+ return 0
+ }
+ }
+ return 1
+ }
+ customMatch listGlob [namespace which ListGlobMatch]
+
# Tcl_PwdObjCmd
-test cmdMZ-1.1 {Tcl_PwdObjCmd} {
- list [catch {pwd a} msg] $msg
-} {1 {wrong # args: should be "pwd"}}
+test cmdMZ-1.1 {Tcl_PwdObjCmd} -returnCodes error -body {
+ pwd a
+} -result {wrong # args: should be "pwd"}
test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} {
catch pwd
} 0
-test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} {
- expr [string length pwd]>0
-} 1
-test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unix nonPortable} {
- # This test fails on various unix platforms (eg Linux) where
- # permissions caching causes this to fail. The caching is strictly
- # incorrect, but we have no control over that.
+test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} -body {
+ pwd
+} -match glob -result {?*}
+test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} -setup {
+ set cwd [pwd]
set foodir [file join [temporaryDirectory] foo]
file delete -force $foodir
file mkdir $foodir
- set cwd [pwd]
cd $foodir
+} -constraints {unix nonPortable} -body {
+ # This test fails on various unix platforms (eg Linux) where permissions
+ # caching causes this to fail. The caching is strictly incorrect, but we
+ # have no control over that.
file attr . -permissions 000
- set result [list [catch {pwd} msg] $msg]
+ pwd
+} -returnCodes error -cleanup {
cd $cwd
file delete -force $foodir
- set result
-} {1 {error getting working directory name: permission denied}}
+} -result {error getting working directory name: permission denied}
# The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.test
# Tcl_RenameObjCmd
-test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} {
- list [catch {rename r1} msg] $msg $::errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
-test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} {
- list [catch {rename r1 r2 r3} msg] $msg $::errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
-test cmdMZ-2.3 {Tcl_RenameObjCmd: success} {
+test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} -returnCodes error -body {
+ rename r1
+} -result {wrong # args: should be "rename oldName newName"}
+test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} -returnCodes error -body {
+ rename r1 r2 r3
+} -result {wrong # args: should be "rename oldName newName"}
+test cmdMZ-2.3 {Tcl_RenameObjCmd: success} -setup {
catch {rename r2 {}}
+} -body {
proc r1 {} {return "r1"}
rename r1 r2
r2
-} {r1}
+} -result {r1}
test cmdMZ-2.4 {Tcl_RenameObjCmd: success} {
proc r1 {} {return "r1"}
rename r1 {}
@@ -88,17 +103,18 @@ test cmdMZ-return-1.2 {return checks for bad option values} -body {
} -returnCodes error -match glob -result {bad completion code*}
test cmdMZ-return-1.3 {return checks for bad option values} -body {
return -level foo
-} -returnCodes error -match glob -result {bad -level value:*}
+} -returnCodes error -match glob -result {bad -level value: *}
test cmdMZ-return-1.4 {return checks for bad option values} -body {
return -level -1
-} -returnCodes error -match glob -result {bad -level value:*}
+} -returnCodes error -match glob -result {bad -level value: *}
test cmdMZ-return-1.5 {return checks for bad option values} -body {
return -level 3.1415926
-} -returnCodes error -match glob -result {bad -level value:*}
+} -returnCodes error -match glob -result {bad -level value: *}
proc dictSort {d} {
+ set result {}
foreach k [lsort [dict keys $d]] {
- lappend result $k [dict get $d $k]
+ dict set result $k [dict get $d $k]
}
return $result
}
@@ -150,67 +166,61 @@ test cmdMZ-return-2.13 {return option handling} -body {
test cmdMZ-return-2.14 {return option handling} -body {
return -level 0 -code error -options {-code foo -options {-code break}}
} -returnCodes break -result {}
-
test cmdMZ-return-2.15 {return opton handling} -setup {
- proc p {} {
- return -code error -errorcode {a b} c
- }
- } -body {
- list [catch p result] $result $::errorCode
- } -cleanup {
- rename p {}
- } -result {1 c {a b}}
-
+ proc p {} {
+ return -code error -errorcode {a b} c
+ }
+} -body {
+ list [catch p result] $result $::errorCode
+} -cleanup {
+ rename p {}
+} -result {1 c {a b}}
test cmdMZ-return-2.16 {return opton handling} -setup {
- proc p {} {
- return -code error -errorcode [list a b] c
- }
- } -body {
- list [catch p result] $result $::errorCode
- } -cleanup {
- rename p {}
- } -result {1 c {a b}}
-
+ proc p {} {
+ return -code error -errorcode [list a b] c
+ }
+} -body {
+ list [catch p result] $result $::errorCode
+} -cleanup {
+ rename p {}
+} -result {1 c {a b}}
test cmdMZ-return-2.17 {return opton handling} -setup {
- proc p {} {
- return -code error -errorcode a\ b c
- }
- } -body {
- list [catch p result] $result $::errorCode
- } -cleanup {
- rename p {}
- } -result {1 c {a b}}
-
+ proc p {} {
+ return -code error -errorcode a\ b c
+ }
+} -body {
+ list [catch p result] $result $::errorCode
+} -cleanup {
+ rename p {}
+} -result {1 c {a b}}
# Check that the result of a [return -options $opts $result] is
-# indistinguishable from that of the originally caught script, no
-# matter what the script is/does. (TIP 90)
-set i 0
-foreach script {
- {}
- {format x}
- {set}
- {set a 1}
- {error}
- {error foo}
- {error foo bar}
- {error foo bar baz}
- {return -level 0}
- {return -code error}
- {return -code error -errorinfo foo}
- {return -code error -errorinfo foo -errorcode bar}
- {return -code error -errorinfo foo -errorcode bar -errorline 10}
- {return -options {x y z 2}}
- {return -level 3 -code break sdf}
+# indistinguishable from that of the originally caught script, no matter what
+# the script is/does. (TIP 90)
+foreach {testid script} {
+ cmdMZ-return-3.0 {}
+ cmdMZ-return-3.1 {format x}
+ cmdMZ-return-3.2 {set}
+ cmdMZ-return-3.3 {set a 1}
+ cmdMZ-return-3.4 {error}
+ cmdMZ-return-3.5 {error foo}
+ cmdMZ-return-3.6 {error foo bar}
+ cmdMZ-return-3.7 {error foo bar baz}
+ cmdMZ-return-3.8 {return -level 0}
+ cmdMZ-return-3.9 {return -code error}
+ cmdMZ-return-3.10 {return -code error -errorinfo foo}
+ cmdMZ-return-3.11 {return -code error -errorinfo foo -errorcode bar}
+ cmdMZ-return-3.12 {return -code error -errorinfo foo -errorcode bar -errorline 10}
+ cmdMZ-return-3.13 {return -options {x y z 2}}
+ cmdMZ-return-3.14 {return -level 3 -code break sdf}
} {
- test cmdMZ-return-3.$i "check that return after a catch is same:\n$script" {
+ test $testid "check that return after a catch is same:\n$script" {
set one [list [catch $script foo bar] $foo [dictSort $bar] \
$::errorCode $::errorInfo]
set two [list [catch {return -options $bar $foo} foo2 bar2] \
$foo2 [dictSort $bar2] $::errorCode $::errorInfo]
string equal $one $two
} 1
- incr i
}
# The tests for Tcl_ScanObjCmd are in scan.test
@@ -220,58 +230,44 @@ foreach script {
test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints {
unixOrPc
-} -body {
- list [catch {source} msg] $msg
-} -match glob -result {1 {wrong # args: should be "source*fileName"}}
+} -returnCodes error -body {
+ source
+} -match glob -result {wrong # args: should be "source*fileName"}
test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints {
unixOrPc
-} -body {
- list [catch {source a b} msg] $msg
-} -match glob -result {1 {wrong # args: should be "source*fileName"}}
-
-proc ListGlobMatch {expected actual} {
- if {[llength $expected] != [llength $actual]} {
- return 0
- }
- foreach e $expected a $actual {
- if {![string match $e $a]} {
- return 0
- }
- }
- return 1
-}
-customMatch listGlob [namespace which ListGlobMatch]
-
+} -returnCodes error -body {
+ source a b
+} -match glob -result {wrong # args: should be "source*fileName"}
test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body {
set file [makeFile {
set x 146
error "error in sourced file"
set y $x
} source.file]
- set result [list [catch {source $file} msg] $msg $::errorInfo]
+ list [catch {source $file} msg] $msg $::errorInfo
+} -cleanup {
removeFile source.file
- set result
} -match listGlob -result {1 {error in sourced file} {error in sourced file
while executing
"error "error in sourced file""
(file "*" line 3)
invoked from within
"source $file"}}
-test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
- set file [makeFile {list result} source.file]
- set result [source $file]
+test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} -body {
+ set file [makeFile {list ok} source.file]
+ source $file
+} -cleanup {
removeFile source.file
- set result
-} result
+} -result ok
# Tcl_SplitObjCmd
-test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} {
- list [catch split msg] $msg $::errorCode
-} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
-test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} {
- list [catch {split a b c} msg] $msg $::errorCode
-} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} -returnCodes error -body {
+ split
+} -result {wrong # args: should be "split string ?splitChars?"}
+test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} -returnCodes error -body {
+ split a b c
+} -result {wrong # args: should be "split string ?splitChars?"}
test cmdMZ-4.3 {Tcl_SplitObjCmd: basic split commands} {
split "a\n b\t\r c\n "
} {a {} b {} {} c {} {}}
@@ -294,23 +290,22 @@ test cmdMZ-4.9 {Tcl_SplitObjCmd: basic split commands} {
split { }
} {{} {} {} {}}
test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} {
- proc foo {} {
+ apply {{} {
set x {}
foreach f [split {]\n} {}] {
append x $f
}
- return $x
- }
- foo
+ return $x
+ }}
} {]\n}
test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} {
- proc foo {} {
+ apply {{} {
set x ab\000c
set y [split $x {}]
- return $y
- }
- foo
-} "a b \000 c"
+ binary scan $y c* z
+ return $z
+ }}
+} {97 32 98 32 0 32 99}
test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} {
split "a0ab1b2bbb3\000c4" ab\000c
} {{} 0 {} 1 2 {} {} 3 {} 4}
@@ -323,21 +318,21 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
# The tests for Tcl_SubstObjCmd are in subst.test
# The tests for Tcl_SwitchObjCmd are in switch.test
-test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} {
- list [catch {time} msg] $msg
-} {1 {wrong # args: should be "time command ?count?"}}
-test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} {
- list [catch {time a b c} msg] $msg
-} {1 {wrong # args: should be "time command ?count?"}}
-test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} {
- list [catch {time a b} msg] $msg
-} {1 {expected integer but got "b"}}
+test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body {
+ time
+} -returnCodes error -result {wrong # args: should be "time command ?count?"}
+test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body {
+ time a b c
+} -returnCodes error -result {wrong # args: should be "time command ?count?"}
+test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} -body {
+ time a b
+} -returnCodes error -result {expected integer but got "b"}
test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} {
time bogusCmd -12456
} {0 microseconds per iteration}
-test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} {
- regexp {^\d+ microseconds per iteration} [time {format 1}]
-} 1
+test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body {
+ time {format 1}
+} -match regexp -result {^\d+ microseconds per iteration}
test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} {
expr {[lindex [time {after 2}] 0] < [lindex [time {after 1000}] 0]}
} 1
@@ -356,3 +351,7 @@ cleanupTests
}
namespace delete ::tcl::test::cmdMZ
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/compile.test b/tests/compile.test
index fe2deea..7d282ae 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -11,7 +11,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: compile.test,v 1.48 2007/12/13 15:26:06 dgp Exp $
+# RCS: @(#) $Id: compile.test,v 1.49 2008/09/10 13:50:05 dkf Exp $
package require tcltest 2
namespace import -force ::tcltest::*
@@ -601,6 +601,91 @@ test compile-17.2 {Command interpretation binding for non-compiled code} -setup
interp delete $i
} -result substituted
+# This tests the supported parts of the unsupported [disassemble] command. It
+# does not check the format of disassembled bytecode though; that's liable to
+# change without warning.
+
+test compile-18.1 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble
+} -match glob -result {wrong # args: should be "*"}
+test compile-18.2 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble ?
+} -match glob -result {bad type "?": must be *}
+test compile-18.3 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble lambda
+} -match glob -result {wrong # args: should be "* lambda lambdaTerm"}
+test compile-18.4 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble lambda \{
+} -result "can't interpret \"\{\" as a lambda expression"
+test compile-18.5 {disassembler - basics} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble lambda {{} {}}
+} -match glob -result *
+test compile-18.6 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble proc
+} -match glob -result {wrong # args: should be "* proc procName"}
+test compile-18.7 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble proc nosuchproc
+} -result {"nosuchproc" isn't a procedure}
+test compile-18.8 {disassembler - basics} -setup {
+ proc chewonthis {} {}
+} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble proc chewonthis
+} -cleanup {
+ rename chewonthis {}
+} -match glob -result *
+test compile-18.9 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble script
+} -match glob -result {wrong # args: should be "* script script"}
+test compile-18.10 {disassembler - basics} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble script {}
+} -match glob -result *
+test compile-18.11 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble method
+} -match glob -result {wrong # args: should be "* method className methodName"}
+test compile-18.12 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble method nosuchclass foo
+} -result {nosuchclass does not refer to an object}
+test compile-18.13 {disassembler - basics} -returnCodes error -setup {
+ oo::object create justanobject
+} -body {
+ tcl::unsupported::disassemble method justanobject foo
+} -cleanup {
+ justanobject destroy
+} -result {"justanobject" is not a class}
+test compile-18.14 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble method oo::object nosuchmethod
+} -result {unknown method "nosuchmethod"}
+test compile-18.15 {disassembler - basics} -setup {
+ oo::class create foo {method bar {} {}}
+} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble method foo bar
+} -cleanup {
+ foo destroy
+} -match glob -result *
+test compile-18.16 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble objmethod
+} -match glob -result {wrong # args: should be "* objmethod objectName methodName"}
+test compile-18.17 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble objmethod nosuchobject foo
+} -result {nosuchobject does not refer to an object}
+test compile-18.18 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble objmethod oo::object nosuchmethod
+} -result {unknown method "nosuchmethod"}
+test compile-18.19 {disassembler - basics} -setup {
+ oo::object create foo
+ oo::objdefine foo {method bar {} {}}
+} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble objmethod foo bar
+} -cleanup {
+ foo destroy
+} -match glob -result *
+# TODO sometime - check that bytecode from tbcload is *not* disassembled.
+
# cleanup
catch {rename p ""}
catch {namespace delete test_ns_compile}
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 2acdbd2..9937618 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -1,13 +1,13 @@
# This file tests the filesystem and vfs internals.
#
-# 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.
+# 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) 2002 Vincent Darley.
#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require tcltest 2
namespace eval ::tcl::test::fileSystem {
@@ -88,6 +88,8 @@ testConstraint hasLinks [expr {![catch {
if {[testConstraint testsetplatform]} {
set platform [testgetplatform]
}
+
+# ----------------------------------------------------------------------
test filesystem-1.0 {link normalisation} {hasLinks} {
string equal [file normalize gorp.file] [file normalize link.file]
@@ -112,16 +114,16 @@ test filesystem-1.5 {link normalisation} {hasLinks} {
[file normalize [file join dir.dir linkinside.file]]
} {1}
test filesystem-1.6 {link normalisation} {hasLinks} {
- string equal [file normalize [file join dir.dir linkinside.file]] \
- [file normalize [file join dir.link inside.file]]
+ string equal [file normalize [file join dir.dir linkinside.file]] \
+ [file normalize [file join dir.link inside.file]]
} {0}
test filesystem-1.7 {link normalisation} {hasLinks unix} {
testPathEqual [file normalize [file join dir.link linkinside.file foo]] \
[file normalize [file join dir.dir inside.file foo]]
} {1}
test filesystem-1.8 {link normalisation} {hasLinks} {
- string equal [file normalize [file join dir.dir linkinside.filefoo]] \
- [file normalize [file join dir.link inside.filefoo]]
+ string equal [file normalize [file join dir.dir linkinside.filefoo]] \
+ [file normalize [file join dir.link inside.filefoo]]
} {0}
test filesystem-1.9 {link normalisation} {unix hasLinks} {
file delete -force dir.link
@@ -203,12 +205,8 @@ test filesystem-1.26 {link normalisation: link and ..} {hasLinks} {
file link dir2.link [file join dir2 foo bar]
set res [list [file normalize [file join dir2 foo x]] \
[file normalize [file join dir2.link .. x]]]
- if {![string equal [lindex $res 0] [lindex $res 1]]} {
- set res "$res not equal"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [lindex $res 0] [lindex $res 1]
+} 1
test filesystem-1.27 {file normalisation: up and down with ..} {
set dir [file join dir2 foo bar]
file mkdir $dir
@@ -229,12 +227,8 @@ test filesystem-1.28 {link normalisation: link with .. and ..} {hasLinks} {
file link dir2.link $to
set res [list [file normalize [file join dir2 foo x]] \
[file normalize [file join dir2.link .. x]]]
- if {![string equal [lindex $res 0] [lindex $res 1]]} {
- set res "$res not equal"
- } else {
- set res "ok"
- }
-} {ok}
+ testPathEqual [lindex $res 0] [lindex $res 1]
+} 1
test filesystem-1.29 {link normalisation: link with ..} {hasLinks} {
file delete -force dir2.link
set dir [file join dir2 foo bar]
@@ -242,11 +236,10 @@ test filesystem-1.29 {link normalisation: link with ..} {hasLinks} {
set to [file join dir2 .. dir2 foo .. foo bar]
file link dir2.link $to
set res [file normalize [file join dir2.link x yyy z]]
- if {[string first ".." $res] != -1} {
- set res "$res must not contain '..'"
- } else {
- set res "ok"
+ if {[string match *..* $res]} {
+ return "$res must not contain '..'"
}
+ return "ok"
} {ok}
test filesystem-1.29.1 {link normalisation with two consecutive links} {hasLinks} {
testPathEqual [file normalize [file join dir.link dirinside.link abc]] \
@@ -260,9 +253,9 @@ file delete -force [file join dir.dir dirinside.link]
removeFile [file join dir.dir inside.file]
removeDirectory [file join dir.dir dirinside.dir]
removeDirectory dir.dir
-test filesystem-1.30 {normalisation of nonexistent user} {
- list [catch {file normalize ~noonewiththisname} err] $err
-} {1 {user "noonewiththisname" doesn't exist}}
+test filesystem-1.30 {normalisation of nonexistent user} -body {
+ file normalize ~noonewiththisname
+} -returnCodes error -result {user "noonewiththisname" doesn't exist}
test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
testsetplatform unix
file normalize /foo/../bar
@@ -275,8 +268,8 @@ test filesystem-1.33 {link normalisation: link near filesystem root} {testsetpla
testsetplatform windows
set res [file normalize C:/../bar]
if {[testConstraint unix]} {
- # Some unices go further in normalizing this -- not really
- # a problem since this is a Windows test
+ # Some unices go further in normalizing this -- not really a problem
+ # since this is a Windows test.
regexp {C:/bar$} $res res
}
set res
@@ -346,7 +339,6 @@ test filesystem-1.39 {file normalisation with volume relative} {win} {
test filesystem-1.40 {file normalisation with repeated separators} {
set a [file norm foo////bar]
set b [file norm foo/bar]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -356,7 +348,6 @@ test filesystem-1.40 {file normalisation with repeated separators} {
test filesystem-1.41 {file normalisation with repeated separators} {win} {
set a [file norm foo\\\\\\bar]
set b [file norm foo/bar]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -366,7 +357,6 @@ test filesystem-1.41 {file normalisation with repeated separators} {win} {
test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /xxx/..]
set b [file norm /]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -376,7 +366,6 @@ test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /xxx/../]
set b [file norm /]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -386,7 +375,6 @@ test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /xxx/foo/../..]
set b [file norm /]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -396,7 +384,6 @@ test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /xxx/foo/../../]
set b [file norm /]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -406,7 +393,6 @@ test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /xxx/foo/../../bar]
set b [file norm /bar]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -416,7 +402,6 @@ test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /xxx/../../bar]
set b [file norm /bar]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -426,7 +411,6 @@ test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /xxx/../bar]
set b [file norm /bar]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -436,7 +420,6 @@ test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /..]
set b [file norm /]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -446,7 +429,6 @@ test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /../]
set b [file norm /]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -456,7 +438,6 @@ test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /.]
set b [file norm /]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -466,7 +447,6 @@ test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /./]
set b [file norm /]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -476,7 +456,6 @@ test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /../..]
set b [file norm /]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -486,7 +465,6 @@ test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} {
test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} {
set a [file norm /../../]
set b [file norm /]
-
if {![string equal $a $b]} {
set res "Paths should be equal: $a , $b"
} else {
@@ -507,15 +485,12 @@ if {[testConstraint testfilesystem]} {
while {![catch {testfilesystem 0}]} {}
}
-test filesystem-3.0 {Tcl_FSRegister} testfilesystem {
- testfilesystem 1
-} {registered}
-test filesystem-3.1 {Tcl_FSUnregister} testfilesystem {
- testfilesystem 0
-} {unregistered}
-test filesystem-3.2 {Tcl_FSUnregister} testfilesystem {
- list [catch {testfilesystem 0} err] $err
-} {1 failed}
+test filesystem-3.1 {Tcl_FSRegister & Tcl_FSUnregister} testfilesystem {
+ set result {}
+ lappend result [testfilesystem 1]
+ lappend result [testfilesystem 0]
+ lappend result [catch {testfilesystem 0} msg] $msg
+} {registered unregistered 1 failed}
test filesystem-3.3 {Tcl_FSRegister} testfilesystem {
testfilesystem 1
testfilesystem 1
@@ -531,274 +506,212 @@ test filesystem-3.5 {Tcl_FSUnregister} testfilesystem {
lindex [file system bar] 0
} {native}
-test filesystem-4.0 {testfilesystem} {
- -constraints testfilesystem
- -match glob
- -body {
- testfilesystem 1
- set filesystemReport {}
- file exists foo
- testfilesystem 0
- set filesystemReport
- }
- -result {*{access foo}}
-}
-test filesystem-4.1 {testfilesystem} {
- -constraints testfilesystem
- -match glob
- -body {
- testfilesystem 1
- set filesystemReport {}
- catch {file stat foo bar}
- testfilesystem 0
- set filesystemReport
- }
- -result {*{stat foo}}
-}
-test filesystem-4.2 {testfilesystem} {
- -constraints testfilesystem
- -match glob
- -body {
- testfilesystem 1
- set filesystemReport {}
- catch {file lstat foo bar}
- testfilesystem 0
- set filesystemReport
- }
- -result {*{lstat foo}}
-}
-test filesystem-4.3 {testfilesystem} {
- -constraints testfilesystem
- -match glob
- -body {
- testfilesystem 1
- set filesystemReport {}
- catch {glob *}
- testfilesystem 0
- set filesystemReport
- }
- -result {*{matchindirectory *}*}
-}
+test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body {
+ testfilesystem 1
+ set filesystemReport {}
+ file exists foo
+ testfilesystem 0
+ set filesystemReport
+} -match glob -result {*{access foo}}
+test filesystem-4.1 {testfilesystem} -constraints testfilesystem -body {
+ testfilesystem 1
+ set filesystemReport {}
+ catch {file stat foo bar}
+ testfilesystem 0
+ set filesystemReport
+} -match glob -result {*{stat foo}}
+test filesystem-4.2 {testfilesystem} -constraints testfilesystem -body {
+ testfilesystem 1
+ set filesystemReport {}
+ catch {file lstat foo bar}
+ testfilesystem 0
+ set filesystemReport
+} -match glob -result {*{lstat foo}}
+test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body {
+ testfilesystem 1
+ set filesystemReport {}
+ catch {glob *}
+ testfilesystem 0
+ set filesystemReport
+} -match glob -result {*{matchindirectory *}*}
-test filesystem-5.1 {cache and ~} {
- -constraints testfilesystem
- -match regexp
- -body {
- set orig $::env(HOME)
- set ::env(HOME) /foo/bar/blah
- set testdir ~
- set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
- set ::env(HOME) /a/b/c
- set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]"
- set ::env(HOME) $orig
- list $res1 $res2
- }
- -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/a/b|a:b)}}
-}
+test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup {
+ set orig $::env(HOME)
+} -body {
+ set ::env(HOME) /foo/bar/blah
+ set testdir ~
+ set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
+ set ::env(HOME) /a/b/c
+ set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]"
+ list $res1 $res2
+} -cleanup {
+ set ::env(HOME) $orig
+} -match regexp -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/a/b|a:b)}}
-test filesystem-6.1 {empty file name} {
- list [catch {open ""} msg] $msg
-} {1 {couldn't open "": no such file or directory}}
-test filesystem-6.2 {empty file name} {
- list [catch {file stat "" arr} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.3 {empty file name} {
- list [catch {file atime ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.4 {empty file name} {
- list [catch {file attributes ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.5 {empty file name} {
- list [catch {file copy "" ""} msg] $msg
-} {1 {error copying "": no such file or directory}}
-test filesystem-6.6 {empty file name} {
- list [catch {file delete ""} msg] $msg
-} {0 {}}
-test filesystem-6.7 {empty file name} {
- list [catch {file dirname ""} msg] $msg
-} {0 .}
-test filesystem-6.8 {empty file name} {
- list [catch {file executable ""} msg] $msg
-} {0 0}
-test filesystem-6.9 {empty file name} {
- list [catch {file exists ""} msg] $msg
-} {0 0}
-test filesystem-6.10 {empty file name} {
- list [catch {file extension ""} msg] $msg
-} {0 {}}
-test filesystem-6.11 {empty file name} {
- list [catch {file isdirectory ""} msg] $msg
-} {0 0}
-test filesystem-6.12 {empty file name} {
- list [catch {file isfile ""} msg] $msg
-} {0 0}
-test filesystem-6.13 {empty file name} {
- list [catch {file join ""} msg] $msg
-} {0 {}}
-test filesystem-6.14 {empty file name} {
- list [catch {file link ""} msg] $msg
-} {1 {could not read link "": no such file or directory}}
-test filesystem-6.15 {empty file name} {
- list [catch {file lstat "" arr} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.16 {empty file name} {
- list [catch {file mtime ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.17 {empty file name} {
- list [catch {file mtime "" 0} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.18 {empty file name} {
- list [catch {file mkdir ""} msg] $msg
-} {1 {can't create directory "": no such file or directory}}
-test filesystem-6.19 {empty file name} {
- list [catch {file nativename ""} msg] $msg
-} {0 {}}
-test filesystem-6.20 {empty file name} {
- list [catch {file normalize ""} msg] $msg
-} {0 {}}
-test filesystem-6.21 {empty file name} {
- list [catch {file owned ""} msg] $msg
-} {0 0}
-test filesystem-6.22 {empty file name} {
- list [catch {file pathtype ""} msg] $msg
-} {0 relative}
-test filesystem-6.23 {empty file name} {
- list [catch {file readable ""} msg] $msg
-} {0 0}
-test filesystem-6.24 {empty file name} {
- list [catch {file readlink ""} msg] $msg
-} {1 {could not readlink "": no such file or directory}}
-test filesystem-6.25 {empty file name} {
- list [catch {file rename "" ""} msg] $msg
-} {1 {error renaming "": no such file or directory}}
-test filesystem-6.26 {empty file name} {
- list [catch {file rootname ""} msg] $msg
-} {0 {}}
-test filesystem-6.27 {empty file name} {
- list [catch {file separator ""} msg] $msg
-} {1 {Unrecognised path}}
-test filesystem-6.28 {empty file name} {
- list [catch {file size ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.29 {empty file name} {
- list [catch {file split ""} msg] $msg
-} {0 {}}
-test filesystem-6.30 {empty file name} {
- list [catch {file system ""} msg] $msg
-} {1 {Unrecognised path}}
-test filesystem-6.31 {empty file name} {
- list [catch {file tail ""} msg] $msg
-} {0 {}}
-test filesystem-6.32 {empty file name} {
- list [catch {file type ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.33 {empty file name} {
- list [catch {file writable ""} msg] $msg
-} {0 0}
+test filesystem-6.1 {empty file name} -returnCodes error -body {
+ open ""
+} -result {couldn't open "": no such file or directory}
+test filesystem-6.2 {empty file name} -returnCodes error -body {
+ file stat "" arr
+} -result {could not read "": no such file or directory}
+test filesystem-6.3 {empty file name} -returnCodes error -body {
+ file atime ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.4 {empty file name} -returnCodes error -body {
+ file attributes ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.5 {empty file name} -returnCodes error -body {
+ file copy "" ""
+} -result {error copying "": no such file or directory}
+test filesystem-6.6 {empty file name} {file delete ""} {}
+test filesystem-6.7 {empty file name} {file dirname ""} .
+test filesystem-6.8 {empty file name} {file executable ""} 0
+test filesystem-6.9 {empty file name} {file exists ""} 0
+test filesystem-6.10 {empty file name} {file extension ""} {}
+test filesystem-6.11 {empty file name} {file isdirectory ""} 0
+test filesystem-6.12 {empty file name} {file isfile ""} 0
+test filesystem-6.13 {empty file name} {file join ""} {}
+test filesystem-6.14 {empty file name} -returnCodes error -body {
+ file link ""
+} -result {could not read link "": no such file or directory}
+test filesystem-6.15 {empty file name} -returnCodes error -body {
+ file lstat "" arr
+} -result {could not read "": no such file or directory}
+test filesystem-6.16 {empty file name} -returnCodes error -body {
+ file mtime ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.17 {empty file name} -returnCodes error -body {
+ file mtime "" 0
+} -result {could not read "": no such file or directory}
+test filesystem-6.18 {empty file name} -returnCodes error -body {
+ file mkdir ""
+} -result {can't create directory "": no such file or directory}
+test filesystem-6.19 {empty file name} {file nativename ""} {}
+test filesystem-6.20 {empty file name} {file normalize ""} {}
+test filesystem-6.21 {empty file name} {file owned ""} 0
+test filesystem-6.22 {empty file name} {file pathtype ""} relative
+test filesystem-6.23 {empty file name} {file readable ""} 0
+test filesystem-6.24 {empty file name} -returnCodes error -body {
+ file readlink ""
+} -result {could not readlink "": no such file or directory}
+test filesystem-6.25 {empty file name} -returnCodes error -body {
+ file rename "" ""
+} -result {error renaming "": no such file or directory}
+test filesystem-6.26 {empty file name} {file rootname ""} {}
+test filesystem-6.27 {empty file name} -returnCodes error -body {
+ file separator ""
+} -result {Unrecognised path}
+test filesystem-6.28 {empty file name} -returnCodes error -body {
+ file size ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.29 {empty file name} {file split ""} {}
+test filesystem-6.30 {empty file name} -returnCodes error -body {
+ file system ""
+} -result {Unrecognised path}
+test filesystem-6.31 {empty file name} {file tail ""} {}
+test filesystem-6.32 {empty file name} -returnCodes error -body {
+ file type ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.33 {empty file name} {file writable ""} 0
# Make sure the testfilesystem hasn't been registered.
if {[testConstraint testfilesystem]} {
while {![catch {testfilesystem 0}]} {}
}
-test filesystem-7.1 {load from vfs} {win testsimplefilesystem} {
- # This may cause a crash on exit
+test filesystem-7.1 {load from vfs} -setup {
set dir [pwd]
+} -constraints {win testsimplefilesystem} -body {
+ # This may cause a crash on exit
cd [file dirname [info nameof]]
set dde [lindex [glob *dde*[info sharedlib]] 0]
testsimplefilesystem 1
# This loads dde via a complex copy-to-temp operation
load simplefs:/$dde dde
testsimplefilesystem 0
- cd $dir
- set res "ok"
+ return ok
# The real result of this test is what happens when Tcl exits.
-} {ok}
-test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} \
- {testsimplefilesystem} {
+} -cleanup {
+ cd $dir
+} -result ok
+test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
# We created this file several tests ago.
set origtime [file mtime gorp.file]
set res [file exists gorp.file]
- if {[catch {
- testsimplefilesystem 1
- file delete -force theCopy
- file copy simplefs:/gorp.file theCopy
- testsimplefilesystem 0
- set newtime [file mtime theCopy]
- file delete theCopy
- } err]} {
- lappend res $err
- set newtime ""
- }
+ testsimplefilesystem 1
+ file delete -force theCopy
+ file copy simplefs:/gorp.file theCopy
+ testsimplefilesystem 0
+ set newtime [file mtime theCopy]
+ lappend res [expr {$origtime == $newtime ? 1 : "$origtime != $newtime"}]
+} -cleanup {
+ catch {file delete theCopy}
cd $dir
- lappend res [expr {$origtime == $newtime}]
-} {1 1}
-test filesystem-7.3 {glob in simplefs} testsimplefilesystem {
+} -result {1 1}
+test filesystem-7.3 {glob in simplefs} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
file mkdir simpledir
close [open [file join simpledir simplefile] w]
testsimplefilesystem 1
- set res [glob -nocomplain -dir simplefs:/simpledir *]
- testsimplefilesystem 0
+ glob -nocomplain -dir simplefs:/simpledir *
+} -cleanup {
+ catch {testsimplefilesystem 0}
file delete -force simpledir
cd $dir
- set res
-} {simplefs:/simpledir/simplefile}
-test filesystem-7.3.1 {glob in simplefs: no path/dir} testsimplefilesystem {
+} -result {simplefs:/simpledir/simplefile}
+test filesystem-7.3.1 {glob in simplefs: no path/dir} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
file mkdir simpledir
close [open [file join simpledir simplefile] w]
testsimplefilesystem 1
set res [glob -nocomplain simplefs:/simpledir/*]
- eval lappend res [glob -nocomplain simplefs:/simpledir]
- testsimplefilesystem 0
+ lappend res {*}[glob -nocomplain simplefs:/simpledir]
+} -cleanup {
+ catch {testsimplefilesystem 0}
file delete -force simpledir
cd $dir
- set res
-} {simplefs:/simpledir/simplefile simplefs:/simpledir}
-test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} testsimplefilesystem {
+} -result {simplefs:/simpledir/simplefile simplefs:/simpledir}
+test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
file mkdir simpledir
close [open [file join simpledir simplefile] w]
testsimplefilesystem 1
- set res [glob -nocomplain simplefs:/s*]
- testsimplefilesystem 0
+ glob -nocomplain simplefs:/s*
+} -cleanup {
+ catch {testsimplefilesystem 0}
file delete -force simpledir
cd $dir
- if {[llength $res] > 0} {
- set res "ok"
- } else {
- set res "no files found with 'glob -nocomplain simplefs:/s*'"
- }
-} {ok}
-test filesystem-7.3.3 {glob in simplefs: pattern is a volume} testsimplefilesystem {
+} -match glob -result ?*
+test filesystem-7.3.3 {glob in simplefs: pattern is a volume} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
file mkdir simpledir
close [open [file join simpledir simplefile] w]
testsimplefilesystem 1
- set res [glob -nocomplain simplefs:/*]
+ glob -nocomplain simplefs:/*
+} -cleanup {
testsimplefilesystem 0
file delete -force simpledir
cd $dir
- if {[llength $res] > 0} {
- set res "ok"
- } else {
- set res "no files found with 'glob -nocomplain simplefs:/*'"
- }
-} {ok}
-test filesystem-7.4 {cross-filesystem file copy with -force} testsimplefilesystem {
+} -match glob -result ?*
+test filesystem-7.4 {cross-filesystem file copy with -force} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
set fout [open [file join simplefile] w]
puts -nonewline $fout "1234567890"
close $fout
testsimplefilesystem 1
+} -constraints testsimplefilesystem -body {
# First copy should succeed
set res [catch {file copy simplefs:/simplefile file2} err]
lappend res $err
@@ -809,19 +722,20 @@ test filesystem-7.4 {cross-filesystem file copy with -force} testsimplefilesyste
lappend res [catch {file copy -force simplefs:/simplefile file2} err]
lappend res $err
lappend res [file exists file2]
- testsimplefilesystem 0
+} -cleanup {
+ catch {testsimplefilesystem 0}
file delete -force simplefile
file delete -force file2
cd $dir
- set res
-} {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1}
-test filesystem-7.5 {cross-filesystem file copy with -force} {testsimplefilesystem unix} {
+} -result {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1}
+test filesystem-7.5 {cross-filesystem file copy with -force} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
set fout [open [file join simplefile] w]
puts -nonewline $fout "1234567890"
close $fout
testsimplefilesystem 1
+} -constraints {testsimplefilesystem unix} -body {
# First copy should succeed
set res [catch {file copy simplefs:/simplefile file2} err]
lappend res $err
@@ -833,13 +747,13 @@ test filesystem-7.5 {cross-filesystem file copy with -force} {testsimplefilesyst
lappend res [catch {file copy -force simplefs:/simplefile file2} err]
lappend res $err
lappend res [file exists file2]
+} -cleanup {
testsimplefilesystem 0
file delete -force simplefile
file delete -force file2
cd $dir
- set res
-} {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1}
-test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem {
+} -result {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1}
+test filesystem-7.6 {cross-filesystem dir copy with -force} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
file delete -force simpledir
@@ -849,6 +763,7 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem
puts -nonewline $fout "1234567890"
close $fout
testsimplefilesystem 1
+} -constraints testsimplefilesystem -body {
# First copy should succeed
set res [catch {file copy simplefs:/simpledir dir2} err]
lappend res $err
@@ -860,13 +775,13 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem
lappend res $err
lappend res [file exists [file join dir2 simpledir]] \
[file exists [file join dir2 simpledir simplefile]]
+} -cleanup {
testsimplefilesystem 0
file delete -force simpledir
file delete -force dir2
cd $dir
- set res
-} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
-test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesystem unix} {
+} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
+test filesystem-7.7 {cross-filesystem dir copy with -force} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
file delete -force simpledir
@@ -876,6 +791,7 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesyste
puts -nonewline $fout "1234567890"
close $fout
testsimplefilesystem 1
+} -constraints {testsimplefilesystem unix} -body {
# First copy should succeed
set res [catch {file copy simplefs:/simpledir dir2} err]
lappend res $err
@@ -883,40 +799,41 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesyste
lappend res [catch {file copy simplefs:/simpledir dir2} err]
lappend res $err
# Third copy should succeed (-force)
- # I've noticed on some Unices that this only succeeds
- # intermittently (some runs work, some fail). This needs
- # examining further.
+ # I've noticed on some Unices that this only succeeds intermittently (some
+ # runs work, some fail). This needs examining further.
lappend res [catch {file copy -force simplefs:/simpledir dir2} err]
lappend res $err
lappend res [file exists [file join dir2 simpledir]] \
[file exists [file join dir2 simpledir simplefile]]
+} -cleanup {
testsimplefilesystem 0
file delete -force simpledir
file delete -force dir2
cd $dir
- set res
-} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
+} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
removeFile gorp.file
-test filesystem-7.8 {vfs cd} testsimplefilesystem {
+test filesystem-7.8 {vfs cd} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
file delete -force simpledir
file mkdir simpledir
testsimplefilesystem 1
- # This can variously cause an infinite loop or simply have
- # no effect at all (before certain bugs were fixed, of course).
+} -constraints testsimplefilesystem -body {
+ # This can variously cause an infinite loop or simply have no effect at
+ # all (before certain bugs were fixed, of course).
cd simplefs:/simpledir
- set res [pwd]
+ pwd
+} -cleanup {
cd [tcltest::temporaryDirectory]
testsimplefilesystem 0
file delete -force simpledir
cd $dir
- set res
-} {simplefs:/simpledir}
+} -result {simplefs:/simpledir}
-test filesystem-8.1 {relative path objects and caching of pwd} {
+test filesystem-8.1 {relative path objects and caching of pwd} -setup {
set dir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
makeDirectory abc
makeDirectory def
makeFile "contents" [file join abc foo]
@@ -927,30 +844,31 @@ test filesystem-8.1 {relative path objects and caching of pwd} {
lappend res [file exists $f]
cd ..
cd def
- # If we haven't cleared the object's cwd cache, Tcl
- # will think it still exists.
+ # If we haven't cleared the object's cwd cache, Tcl will think it still
+ # exists.
lappend res [file exists $f]
lappend res [file exists $f]
+} -cleanup {
removeFile [file join abc foo]
removeDirectory abc
removeDirectory def
cd $dir
- set res
-} {1 1 0 0}
-test filesystem-8.2 {relative path objects and use of pwd} {
+} -result {1 1 0 0}
+test filesystem-8.2 {relative path objects and use of pwd} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
set dir "abc"
makeDirectory $dir
makeFile "contents" [file join abc foo]
cd $dir
- set res [file exists [lindex [glob *] 0]]
- cd ..
+ file exists [lindex [glob *] 0]
+} -cleanup {
+ cd [tcltest::temporaryDirectory]
removeFile [file join abc foo]
removeDirectory abc
cd $origdir
- set res
-} {1}
+} -result 1
test filesystem-8.3 {path objects and empty string} {
set anchor ""
set dst foo
@@ -966,7 +884,7 @@ proc TestFind1 {d f} {
lappend res "is dir a dir? [file isdirectory $d]"
set r2 [file exists [file join $d $f]]
lappend res "[file join $d $f] found: $r2"
- set res
+ return $res
}
proc TestFind2 {d f} {
set r1 [file exists [file join $d $f]]
@@ -974,67 +892,74 @@ proc TestFind2 {d f} {
lappend res "is dir a dir? [file isdirectory [file join $d]]"
set r2 [file exists [file join $d $f]]
lappend res "[file join $d $f] found: $r2"
- set res
+ return $res
}
-test filesystem-9.1 {path objects and join and object rep} {
+test filesystem-9.1 {path objects and join and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir [file join a b c]
- set res [TestFind1 a [file join b . c]]
+ TestFind1 a [file join b . c]
+} -cleanup {
file delete -force a
cd $origdir
- set res
-} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
-test filesystem-9.2 {path objects and join and object rep} {
+} -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
+test filesystem-9.2 {path objects and join and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir [file join a b c]
- set res [TestFind2 a [file join b . c]]
+ TestFind2 a [file join b . c]
+} -cleanup {
file delete -force a
cd $origdir
- set res
-} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
-test filesystem-9.2.1 {path objects and join and object rep} {
+} -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
+test filesystem-9.2.1 {path objects and join and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir [file join a b c]
- set res [TestFind2 a [file join b .]]
+ TestFind2 a [file join b .]
+} -cleanup {
file delete -force a
cd $origdir
- set res
-} {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}}
-test filesystem-9.3 {path objects and join and object rep} {
+} -result {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}}
+test filesystem-9.3 {path objects and join and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir [file join a b c]
- set res [TestFind1 a [file join b .. b c]]
+ TestFind1 a [file join b .. b c]
+} -cleanup {
file delete -force a
cd $origdir
- set res
-} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
-test filesystem-9.4 {path objects and join and object rep} {
+} -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
+test filesystem-9.4 {path objects and join and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir [file join a b c]
- set res [TestFind2 a [file join b .. b c]]
+ TestFind2 a [file join b .. b c]
+} -cleanup {
file delete -force a
cd $origdir
- set res
-} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
-test filesystem-9.5 {path objects and file tail and object rep} {
+} -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
+test filesystem-9.5 {path objects and file tail and object rep} -setup {
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir dgp
close [open dgp/test w]
foreach relative [glob -nocomplain [file join * test]] {
set absolute [file join [pwd] $relative]
set res [list [file tail $absolute] "test"]
}
+ return $res
+} -cleanup {
file delete -force dgp
cd $origdir
- set res
-} {test test}
+} -result {test test}
test filesystem-9.6 {path objects and file tail and object rep} win {
set res {}
set p "C:\\toto"
@@ -1042,10 +967,11 @@ test filesystem-9.6 {path objects and file tail and object rep} win {
file isdirectory $p
lappend res [file join $p toto]
} {C:/toto/toto C:/toto/toto}
-test filesystem-9.7 {path objects and glob and file tail and tilde} {
+test filesystem-9.7 {path objects and glob and file tail and tilde} -setup {
set res {}
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir tilde
close [open tilde/~testNotExist w]
cd tilde
@@ -1054,15 +980,16 @@ test filesystem-9.7 {path objects and glob and file tail and tilde} {
lappend res $file
lappend res [file exists $file] [catch {file tail $file} r] $r
lappend res [catch {file tail $file} r] $r
- cd ..
+} -cleanup {
+ cd [tcltest::temporaryDirectory]
file delete -force tilde
cd $origdir
- set res
-} {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
-test filesystem-9.8 {path objects and glob and file tail and tilde} {
+} -result {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
+test filesystem-9.8 {path objects and glob and file tail and tilde} -setup {
set res {}
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir tilde
close [open tilde/~testNotExist w]
cd tilde
@@ -1071,15 +998,16 @@ test filesystem-9.8 {path objects and glob and file tail and tilde} {
lappend res $file1 $file2
lappend res [catch {file tail $file1} r] $r
lappend res [catch {file tail $file2} r] $r
- cd ..
+} -cleanup {
+ cd [tcltest::temporaryDirectory]
file delete -force tilde
cd $origdir
- set res
-} {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
-test filesystem-9.9 {path objects and glob and file tail and tilde} {
+} -result {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
+test filesystem-9.9 {path objects and glob and file tail and tilde} -setup {
set res {}
set origdir [pwd]
cd [tcltest::temporaryDirectory]
+} -body {
file mkdir tilde
close [open tilde/~testNotExist w]
cd tilde
@@ -1088,14 +1016,20 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} {
lappend res [catch {file exists $file1} r] $r
lappend res [catch {file exists $file2} r] $r
lappend res [string equal $file1 $file2]
- cd ..
+} -cleanup {
+ cd [tcltest::temporaryDirectory]
file delete -force tilde
cd $origdir
- set res
-} {0 0 0 0 1}
+} -result {0 0 0 0 1}
+
+# ----------------------------------------------------------------------
cleanupTests
unset -nocomplain drive
}
namespace delete ::tcl::test::fileSystem
return
+
+# Local Variables:
+# mode: tcl
+# End: