diff options
Diffstat (limited to 'tests/apply.test')
| -rw-r--r-- | tests/apply.test | 136 |
1 files changed, 136 insertions, 0 deletions
diff --git a/tests/apply.test b/tests/apply.test new file mode 100644 index 0000000..abf6438 --- /dev/null +++ b/tests/apply.test @@ -0,0 +1,136 @@ +# Commands covered: apply +# +# 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-1996 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 2005-2006 Miguel Sofer +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. + +source [file dirname [info script]]/testing.tcl + +needs cmd apply + + +# Tests for wrong number of arguments + +test apply-1.1 {too few arguments} -returnCodes error -body { + apply +} -result {wrong # args: should be "apply lambdaExpr ?arg ...?"} + +# Tests for malformed lambda + +test apply-2.0 {malformed lambda} -returnCodes error -body { + set lambda a + apply $lambda +} -result {can't interpret "a" as a lambda expression} +test apply-2.1 {malformed lambda} -returnCodes error -body { + set lambda [list a b c d] + apply $lambda +} -result {can't interpret "a b c d" as a lambda expression} +test apply-2.2 {malformed lambda} -body { + set lambda [list {{}} boo] + apply $lambda +} -returnCodes error -match glob -result {*argument with no name} +test apply-2.3 {malformed lambda} { + set lambda [list {{a b c}} boo] + list [catch {apply $lambda} msg] $msg +} {1 {too many fields in argument specifier "a b c"}} + +# Note that Jim allow both of these +test apply-2.4 {malformed lambda} tcl { + set lambda [list a(1) {return $a(1)}] + list [catch {apply $lambda x} msg] $msg +} {1 {formal parameter "a(1)" is an array element}} +test apply-2.5 {malformed lambda} tcl { + set lambda [list a::b {return $a::b}] + list [catch {apply $lambda x} msg] $msg +} {1 {formal parameter "a::b" is not a simple name}} + +# Tests for runtime errors in the lambda expression + +test apply-4.1 {error in arguments to lambda expression} -body { + set lambda [list x {set x 1}] + apply $lambda +} -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"} +test apply-4.2 {error in arguments to lambda expression} -body { + set lambda [list x {set x 1}] + apply $lambda a b +} -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"} + +test apply-5.1 {runtime error in lambda expression} { + set lambda [list {} {error foo}] + list [catch {apply $lambda} msg] $msg +} {1 foo} + +# Tests for correct execution; as the implementation is the same as that for +# procs, the general functionality is mostly tested elsewhere + +test apply-6.1 {info level} { + set lev [info level] + set lambda [list {} {info level}] + expr {[apply $lambda] - $lev} +} 1 +test apply-6.2 {info level} tcl { + set lambda [list {} {info level 0}] + apply $lambda +} {apply {{} {info level 0}}} +test apply-6.3 {info level} tcl { + set lambda [list args {info level 0}] + apply $lambda x y +} {apply {args {info level 0}} x y} + +# Tests for correct argument treatment + +set applyBody { + set res {} + foreach v [lsort [info locals]] { + if {$v eq "res"} continue + lappend res [list $v [set $v]] + } + set res +} + +test apply-8.1 {args treatment} { + apply [list args $applyBody] 1 2 3 +} {{args {1 2 3}}} +test apply-8.2 {args treatment} { + apply [list {x args} $applyBody] 1 2 +} {{args 2} {x 1}} +test apply-8.3 {args treatment} { + apply [list {x args} $applyBody] 1 2 3 +} {{args {2 3}} {x 1}} +test apply-8.4 {default values} { + apply [list {{x 1} {y 2}} $applyBody] +} {{x 1} {y 2}} +test apply-8.5 {default values} { + apply [list {{x 1} {y 2}} $applyBody] 3 4 +} {{x 3} {y 4}} +test apply-8.6 {default values} { + apply [list {{x 1} {y 2}} $applyBody] 3 +} {{x 3} {y 2}} +test apply-8.7 {default values} { + apply [list {x {y 2}} $applyBody] 1 +} {{x 1} {y 2}} +test apply-8.8 {default values} { + apply [list {x {y 2}} $applyBody] 1 3 +} {{x 1} {y 3}} +test apply-8.9 {default values} { + apply [list {x {y 2} args} $applyBody] 1 +} {{args {}} {x 1} {y 2}} +test apply-8.10 {default values} { + apply [list {x {y 2} args} $applyBody] 1 3 +} {{args {}} {x 1} {y 3}} + +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# fill-column: 78 +# End: |