diff options
Diffstat (limited to 'tests/incr.test')
-rw-r--r-- | tests/incr.test | 230 |
1 files changed, 116 insertions, 114 deletions
diff --git a/tests/incr.test b/tests/incr.test index 9243be0..253cb1d 100644 --- a/tests/incr.test +++ b/tests/incr.test @@ -1,56 +1,51 @@ # 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 {"::tcltest" ni [namespace children]} { +if {[lsearch [namespace children] ::tcltest] == -1} { 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. -test incr-1.1 {TclCompileIncrCmd: missing variable name} -returnCodes error -body { - incr -} -result {wrong # args: should be "incr varName ?increment?"} +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.2 {TclCompileIncrCmd: simple variable name} { set i 10 list [incr i] $i } {11 11} -test incr-1.3 {TclCompileIncrCmd: error compiling variable name} -body { +test incr-1.3 {TclCompileIncrCmd: error compiling variable name} { set i 10 - incr "i"xxx -} -returnCodes error -result {extra characters after close-quote} + catch {incr "i"xxx} msg + set msg +} {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} -setup { - unset -nocomplain {a simple var} -} -body { +test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} { + catch {unset {a simple var}} set {a simple var} 27 list [incr {a simple var}] ${a simple var} -} -result {28 28} -test incr-1.6 {TclCompileIncrCmd: simple array variable name} -setup { - unset -nocomplain a -} -body { +} {28 28} +test incr-1.6 {TclCompileIncrCmd: simple array variable name} { + catch {unset a} set a(foo) 37 list [incr a(foo)] $a(foo) -} -result {38 38} +} {38 38} test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} { set x "i" set i 77 @@ -61,6 +56,7 @@ 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 @@ -69,6 +65,7 @@ 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 @@ -150,23 +147,22 @@ test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} { } 260locals } {1} -test incr-1.15 {TclCompileIncrCmd: variable is array} -setup { - unset -nocomplain a -} -body { +test incr-1.15 {TclCompileIncrCmd: variable is array} { + catch {unset a} set a(foo) 27 - 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 x [incr a(foo) 11] + catch {unset a} + set x +} 38 +test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} { + catch {unset a} set i 5 set a(foo5) 27 - incr a(foo$i) 11 -} -cleanup { - unset -nocomplain a -} -result 38 + set x [incr a(foo$i) 11] + catch {unset a} + set x +} 38 + test incr-1.17 {TclCompileIncrCmd: increment given, simple int} { set i 5 incr i 123 @@ -177,8 +173,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]} -> opts - dict get $opts -errorinfo + catch {incr i [set]} msg + set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} @@ -198,14 +194,19 @@ 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} -body { +test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} { set i 25 - incr i 1a -} -returnCodes error -result {expected integer but got "1a"} -test incr-1.25 {TclCompileIncrCmd: too many arguments} -body { + catch {incr i 1a} msg + set msg +} {expected integer but got "1a"} + +test incr-1.25 {TclCompileIncrCmd: too many arguments} { set i 10 - incr i 10 20 -} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} + catch {incr i 10 20} msg + set msg +} {wrong # args: should be "incr varName ?increment?"} + + test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} { unset -nocomplain {"foo} incr {"foo} @@ -216,68 +217,69 @@ 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 - readonly x + trace var x w readonly list [catch {incr x 1} msg] $msg $::errorInfo -} -match glob -cleanup { - unset -nocomplain x -} -result {1 {can't set "x": variable is read-only} {*variable is read-only +} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing * "incr x 1"}} -test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body { +catch {unset x} +test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} { set x " - " - incr x 1 -} -returnCodes error -result {expected integer but got " - "} -test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup { + list [catch {incr x 1} msg] $msg +} {1 {expected integer but got " - "}} + +test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} { catch {unset array} -} -body { set array(\$foo) 4 incr {array($foo)} -} -result 5 - +} 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 - return $i + set i } 4 -test incr-2.1 {incr command (not compiled): missing variable name} -body { +catch {unset x} +catch {unset i} + +test incr-2.1 {incr command (not compiled): missing variable name} { set z incr - $z -} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"} + list [catch {$z} msg] $msg +} {1 {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} -body { +test incr-2.3 {incr command (not compiled): error compiling variable name} { set z incr set i 10 - $z "i"xxx -} -returnCodes error -result {extra characters after close-quote} + catch {$z "i"xxx} msg + set msg +} {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} -setup { - unset -nocomplain {a simple var} -} -body { +test incr-2.5 {incr command (not compiled): simple variable name in braces} { set z incr + catch {unset {a simple var}} set {a simple var} 27 list [$z {a simple var}] ${a simple var} -} -result {28 28} -test incr-2.6 {incr command (not compiled): simple array variable name} -setup { - unset -nocomplain a -} -body { +} {28 28} +test incr-2.6 {incr command (not compiled): simple array variable name} { set z incr + catch {unset a} set a(foo) 37 list [$z a(foo)] $a(foo) -} -result {38 38} +} {38 38} test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} { set z incr set x "i" @@ -290,6 +292,7 @@ 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 @@ -300,6 +303,7 @@ 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 @@ -385,25 +389,24 @@ 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} -setup { - unset -nocomplain a -} -body { +test incr-2.15 {incr command (not compiled): variable is array} { set z incr + catch {unset a} set a(foo) 27 - $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 x [$z a(foo) 11] + catch {unset a} + set x +} 38 +test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} { set z incr + catch {unset a} set i 5 set a(foo5) 27 - $z a(foo$i) 11 -} -cleanup { - unset -nocomplain a -} -result 38 + set x [$z a(foo$i) 11] + catch {unset a} + set x +} 38 + test incr-2.17 {incr command (not compiled): increment given, simple int} { set z incr set i 5 @@ -417,8 +420,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]} -> opts - dict get $opts -errorinfo + catch {$z i [set]} msg + set ::errorInfo } -match glob -result {wrong # args: should be "set varName ?newValue?" while *ing "set"*} @@ -442,22 +445,26 @@ 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} -body { +test incr-2.24 {incr command (not compiled): increment given, formatted int != int} { set z incr set i 25 - $z i 1a -} -returnCodes error -result {expected integer but got "1a"} -test incr-2.25 {incr command (not compiled): too many arguments} -body { + catch {$z i 1a} msg + set msg +} {expected integer but got "1a"} + +test incr-2.25 {incr command (not compiled): too many arguments} { set z incr set i 10 - $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 { + 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} { unset -nocomplain {"foo} -} -body { set z incr $z {"foo} -} -result 1 +} 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 @@ -466,20 +473,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 - readonly x + trace var x w readonly list [catch {$z x 1} msg] $msg $::errorInfo -} -match glob -cleanup { - unset -nocomplain x -} -result {1 {can't set "x": variable is read-only} {*variable is read-only +} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing * "$z x 1"}} -test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body { +catch {unset x} +test incr-2.29 {incr command (not compiled): runtime error, bad variable value} { set z incr set x " - " - $z x 1 -} -returnCodes error -result {expected integer but got " - "} + list [catch {$z x 1} msg] $msg +} {1 {expected integer but got " - "}} test incr-2.30 {incr command (not compiled): bad increment} { set z incr set x 0 @@ -511,12 +518,7 @@ 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: |