summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2011-03-10 14:52:13 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2011-03-10 14:52:13 (GMT)
commit5dcb1f9d84afc356cd64d639642cf059ef6c566c (patch)
tree737e0d284648cea10f59a6a1b78fcb3f194944ae /tests
parent62c99a1fde06fc47b9a61460f1ab2fdfc7ede16f (diff)
parenta4400dbc29df9167ce93222e822d8f2868215f8a (diff)
downloadtcl-5dcb1f9d84afc356cd64d639642cf059ef6c566c.zip
tcl-5dcb1f9d84afc356cd64d639642cf059ef6c566c.tar.gz
tcl-5dcb1f9d84afc356cd64d639642cf059ef6c566c.tar.bz2
Merge to feature branch
Diffstat (limited to 'tests')
-rw-r--r--tests/incr.test230
-rw-r--r--tests/init.test28
-rw-r--r--tests/package.test6
3 files changed, 128 insertions, 136 deletions
diff --git a/tests/incr.test b/tests/incr.test
index 253cb1d..9243be0 100644
--- a/tests/incr.test
+++ b/tests/incr.test
@@ -1,51 +1,56 @@
# Commands covered: incr
#
-# 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) 1996 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.
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
+unset -nocomplain x i
+proc readonly varName {
+ upvar 1 $varName var
+ trace add variable var write \
+ {apply {{args} {error "variable is read-only"}}}
+}
+
# Basic "incr" operation.
-catch {unset x}
-catch {unset i}
-
-test incr-1.1 {TclCompileIncrCmd: missing variable name} {
- list [catch {incr} msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
+test incr-1.1 {TclCompileIncrCmd: missing variable name} -returnCodes error -body {
+ incr
+} -result {wrong # args: should be "incr varName ?increment?"}
test incr-1.2 {TclCompileIncrCmd: simple variable name} {
set i 10
list [incr i] $i
} {11 11}
-test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
+test incr-1.3 {TclCompileIncrCmd: error compiling variable name} -body {
set i 10
- catch {incr "i"xxx} msg
- set msg
-} {extra characters after close-quote}
+ incr "i"xxx
+} -returnCodes error -result {extra characters after close-quote}
test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
set i 17
list [incr "i"] $i
} {18 18}
-test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} {
- catch {unset {a simple var}}
+test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} -setup {
+ unset -nocomplain {a simple var}
+} -body {
set {a simple var} 27
list [incr {a simple var}] ${a simple var}
-} {28 28}
-test incr-1.6 {TclCompileIncrCmd: simple array variable name} {
- catch {unset a}
+} -result {28 28}
+test incr-1.6 {TclCompileIncrCmd: simple array variable name} -setup {
+ unset -nocomplain a
+} -body {
set a(foo) 37
list [incr a(foo)] $a(foo)
-} {38 38}
+} -result {38 38}
test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
set x "i"
set i 77
@@ -56,7 +61,6 @@ test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
set i 77
list [incr [set x] +2] $i
} {79 79}
-
test incr-1.9 {TclCompileIncrCmd: increment given} {
set i 10
list [incr i +07] $i
@@ -65,7 +69,6 @@ test incr-1.10 {TclCompileIncrCmd: no increment given} {
set i 10
list [incr i] $i
} {11 11}
-
test incr-1.11 {TclCompileIncrCmd: simple global name} {
proc p {} {
global i
@@ -147,22 +150,23 @@ test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
}
260locals
} {1}
-test incr-1.15 {TclCompileIncrCmd: variable is array} {
- catch {unset a}
+test incr-1.15 {TclCompileIncrCmd: variable is array} -setup {
+ unset -nocomplain a
+} -body {
set a(foo) 27
- set x [incr a(foo) 11]
- catch {unset a}
- set x
-} 38
-test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} {
- catch {unset a}
+ incr a(foo) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
+test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} -setup {
+ unset -nocomplain a
+} -body {
set i 5
set a(foo5) 27
- set x [incr a(foo$i) 11]
- catch {unset a}
- set x
-} 38
-
+ incr a(foo$i) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
set i 5
incr i 123
@@ -173,8 +177,8 @@ test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
} -95
test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} -body {
set i 5
- catch {incr i [set]} msg
- set ::errorInfo
+ catch {incr i [set]} -> opts
+ dict get $opts -errorinfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -194,19 +198,14 @@ test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
set i 25
incr i 0o00012345 ;# an octal literal
} 5374
-test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
+test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} -body {
set i 25
- catch {incr i 1a} msg
- set msg
-} {expected integer but got "1a"}
-
-test incr-1.25 {TclCompileIncrCmd: too many arguments} {
+ incr i 1a
+} -returnCodes error -result {expected integer but got "1a"}
+test incr-1.25 {TclCompileIncrCmd: too many arguments} -body {
set i 10
- catch {incr i 10 20} msg
- set msg
-} {wrong # args: should be "incr varName ?increment?"}
-
-
+ incr i 10 20
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} {
unset -nocomplain {"foo}
incr {"foo}
@@ -217,69 +216,68 @@ test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body {
while *ing
"set"*}}
test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body {
- proc readonly args {error "variable is read-only"}
set x 123
- trace var x w readonly
+ readonly x
list [catch {incr x 1} msg] $msg $::errorInfo
-} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
+} -match glob -cleanup {
+ unset -nocomplain x
+} -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
"incr x 1"}}
-catch {unset x}
-test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
+test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body {
set x " - "
- list [catch {incr x 1} msg] $msg
-} {1 {expected integer but got " - "}}
-
-test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} {
+ incr x 1
+} -returnCodes error -result {expected integer but got " - "}
+test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup {
catch {unset array}
+} -body {
set array(\$foo) 4
incr {array($foo)}
-} 5
-
+} -result 5
+
# Check "incr" and computed command names.
+unset -nocomplain x i
test incr-2.0 {incr and computed command names} {
set i 5
set z incr
$z i -1
- set i
+ return $i
} 4
-catch {unset x}
-catch {unset i}
-
-test incr-2.1 {incr command (not compiled): missing variable name} {
+test incr-2.1 {incr command (not compiled): missing variable name} -body {
set z incr
- list [catch {$z} msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
+ $z
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
test incr-2.2 {incr command (not compiled): simple variable name} {
set z incr
set i 10
list [$z i] $i
} {11 11}
-test incr-2.3 {incr command (not compiled): error compiling variable name} {
+test incr-2.3 {incr command (not compiled): error compiling variable name} -body {
set z incr
set i 10
- catch {$z "i"xxx} msg
- set msg
-} {extra characters after close-quote}
+ $z "i"xxx
+} -returnCodes error -result {extra characters after close-quote}
test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
set z incr
set i 17
list [$z "i"] $i
} {18 18}
-test incr-2.5 {incr command (not compiled): simple variable name in braces} {
+test incr-2.5 {incr command (not compiled): simple variable name in braces} -setup {
+ unset -nocomplain {a simple var}
+} -body {
set z incr
- catch {unset {a simple var}}
set {a simple var} 27
list [$z {a simple var}] ${a simple var}
-} {28 28}
-test incr-2.6 {incr command (not compiled): simple array variable name} {
+} -result {28 28}
+test incr-2.6 {incr command (not compiled): simple array variable name} -setup {
+ unset -nocomplain a
+} -body {
set z incr
- catch {unset a}
set a(foo) 37
list [$z a(foo)] $a(foo)
-} {38 38}
+} -result {38 38}
test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
set z incr
set x "i"
@@ -292,7 +290,6 @@ test incr-2.8 {incr command (not compiled): non-simple (computed) variable name}
set i 77
list [$z [set x] +2] $i
} {79 79}
-
test incr-2.9 {incr command (not compiled): increment given} {
set z incr
set i 10
@@ -303,7 +300,6 @@ test incr-2.10 {incr command (not compiled): no increment given} {
set i 10
list [$z i] $i
} {11 11}
-
test incr-2.11 {incr command (not compiled): simple global name} {
proc p {} {
set z incr
@@ -389,24 +385,25 @@ test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
}
260locals
} {1}
-test incr-2.15 {incr command (not compiled): variable is array} {
+test incr-2.15 {incr command (not compiled): variable is array} -setup {
+ unset -nocomplain a
+} -body {
set z incr
- catch {unset a}
set a(foo) 27
- set x [$z a(foo) 11]
- catch {unset a}
- set x
-} 38
-test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} {
+ $z a(foo) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
+test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} -setup {
+ unset -nocomplain a
+} -body {
set z incr
- catch {unset a}
set i 5
set a(foo5) 27
- set x [$z a(foo$i) 11]
- catch {unset a}
- set x
-} 38
-
+ $z a(foo$i) 11
+} -cleanup {
+ unset -nocomplain a
+} -result 38
test incr-2.17 {incr command (not compiled): increment given, simple int} {
set z incr
set i 5
@@ -420,8 +417,8 @@ test incr-2.18 {incr command (not compiled): increment given, simple int} {
test incr-2.19 {incr command (not compiled): increment given, but erroneous} -body {
set z incr
set i 5
- catch {$z i [set]} msg
- set ::errorInfo
+ catch {$z i [set]} -> opts
+ dict get $opts -errorinfo
} -match glob -result {wrong # args: should be "set varName ?newValue?"
while *ing
"set"*}
@@ -445,26 +442,22 @@ test incr-2.23 {incr command (not compiled): increment given, formatted int != i
set i 25
$z i 0o00012345 ;# an octal literal
} 5374
-test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
+test incr-2.24 {incr command (not compiled): increment given, formatted int != int} -body {
set z incr
set i 25
- catch {$z i 1a} msg
- set msg
-} {expected integer but got "1a"}
-
-test incr-2.25 {incr command (not compiled): too many arguments} {
+ $z i 1a
+} -returnCodes error -result {expected integer but got "1a"}
+test incr-2.25 {incr command (not compiled): too many arguments} -body {
set z incr
set i 10
- catch {$z i 10 20} msg
- set msg
-} {wrong # args: should be "incr varName ?increment?"}
-
-
-test incr-2.26 {incr command (not compiled): runtime error, bad variable name} {
+ $z i 10 20
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
+test incr-2.26 {incr command (not compiled): runtime error, bad variable name} -setup {
unset -nocomplain {"foo}
+} -body {
set z incr
$z {"foo}
-} 1
+} -result 1
test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body {
set z incr
list [catch {$z [set]} msg] $msg $::errorInfo
@@ -473,20 +466,20 @@ test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -
"set"*}}
test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -body {
set z incr
- proc readonly args {error "variable is read-only"}
set x 123
- trace var x w readonly
+ readonly x
list [catch {$z x 1} msg] $msg $::errorInfo
-} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
+} -match glob -cleanup {
+ unset -nocomplain x
+} -result {1 {can't set "x": variable is read-only} {*variable is read-only
while executing
*
"$z x 1"}}
-catch {unset x}
-test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
+test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body {
set z incr
set x " - "
- list [catch {$z x 1} msg] $msg
-} {1 {expected integer but got " - "}}
+ $z x 1
+} -returnCodes error -result {expected integer but got " - "}
test incr-2.30 {incr command (not compiled): bad increment} {
set z incr
set x 0
@@ -518,7 +511,12 @@ test incr-4.1 {increment non-existing array element [Bug 1445454]} -body {
} -cleanup {
rename x {}
} -result 1
-
+
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/init.test b/tests/init.test
index 40fa507..62b3af2 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -45,26 +45,22 @@ test init-1.7 {auto_qualify - multiples colons 1} {
test init-1.8 {auto_qualify - multiple colons 2} {
auto_qualify :::foo ::bar
} foo
-
+
# We use a sub-interp and auto_reset and double the tests because there is 2
# places where auto_loading occur (before loading the indexes files and after)
set testInterp [interp create]
-interp eval $testInterp [list set argv $argv]
+tcltest::loadIntoSlaveInterpreter $testInterp {*}$argv
interp eval $testInterp {
- package require tcltest 2
namespace import -force ::tcltest::*
customMatch pairwise {apply {{mode pair} {
if {[llength $pair] != 2} {error "need a pair of values to check"}
string $mode [lindex $pair 0] [lindex $pair 1]
}}}
-}
-# TODO: Connect result reporting to master interp
-interp eval $testInterp {
-
-auto_reset
-catch {rename parray {}}
+ auto_reset
+ catch {rename parray {}}
+
test init-2.0 {load parray - stage 1} -body {
parray
} -returnCodes error -cleanup {
@@ -127,12 +123,12 @@ test init-3.0 {random stuff in the auto_index, should still work} {
set count 0
foreach arg [subst -nocommands -novariables {
- c
- {argument
+ c
+ {argument
which spans
multiple lines}
- {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
- {argument which spans multiple lines
+ {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
+ {argument which spans multiple lines
and is long enough to be truncated and
" <- includes a false lead in the prune point search
and must be longer still to force truncation}
@@ -141,13 +137,13 @@ foreach arg [subst -nocommands -novariables {
error stack cannot be uniquely determined.
foo bar foo
"}
- {contrived example: rare circumstance
+ {contrived example: rare circumstance
where the point at which to prune the
error stack cannot be uniquely determined.
foo bar
"}
- {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
- }] {
+ {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
+ }] { ;# emacs needs -> "
test init-4.$count.0 {::errorInfo produced by [unknown]} -setup {
auto_reset
diff --git a/tests/package.test b/tests/package.test
index dbeedb7..55aaf2b 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -19,11 +19,9 @@ if {"::tcltest" ni [namespace children]} {
# Do all this in a slave interp to avoid garbaging the package list
set i [interp create]
-interp eval $i [list set argv $argv]
-interp eval $i [list package require tcltest 2]
-interp eval $i [list namespace import -force ::tcltest::*]
+tcltest::loadIntoSlaveInterpreter $i {*}$argv
interp eval $i {
-
+namespace import -force ::tcltest::*
package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}