# 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. # # RCS: @(#) $Id: apply.test,v 1.7 2001/07/03 23:39:24 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } if {[info commands ::apply] eq {}} { return } # Tests for wrong number of arguments test apply-1.1 {too few arguments} { set res [catch apply msg] list $res $msg } {1 {wrong # args: should be "apply lambdaExpr ?arg1 arg2 ...?"}} # Tests for malformed lambda test apply-2.0 {malformed lambda} { set lambda a set res [catch {apply $lambda} msg] list $res $msg } {1 {can't interpret "a" as a lambda expression}} test apply-2.1 {malformed lambda} { set lambda [list a b c d] set res [catch {apply $lambda} msg] list $res $msg } {1 {can't interpret "a b c d" as a lambda expression}} test apply-2.2 {malformed lambda} { set lambda [list {{}} boo] set res [catch {apply $lambda} msg] list $res $msg $::errorInfo } {1 {argument with no name} {argument with no name (parsing lambda expression "{{}} boo") invoked from within "apply $lambda"}} test apply-2.3 {malformed lambda} { set lambda [list {{a b c}} boo] set res [catch {apply $lambda} msg] list $res $msg $::errorInfo } {1 {too many fields in argument specifier "a b c"} {too many fields in argument specifier "a b c" (parsing lambda expression "{{a b c}} boo") invoked from within "apply $lambda"}} test apply-2.4 {malformed lambda} { set lambda [list a(1) boo] set res [catch {apply $lambda} msg] list $res $msg $::errorInfo } {1 {formal parameter "a(1)" is an array element} {formal parameter "a(1)" is an array element (parsing lambda expression "a(1) boo") invoked from within "apply $lambda"}} test apply-2.5 {malformed lambda} { set lambda [list a::b boo] set res [catch {apply $lambda} msg] list $res $msg $::errorInfo } {1 {formal parameter "a::b" is not a simple name} {formal parameter "a::b" is not a simple name (parsing lambda expression "a::b boo") invoked from within "apply $lambda"}} # Tests for runtime errors in the lambda expression test apply-3.1 {non-existing namespace} { set lambda [list x {set x 1} ::NONEXIST::FOR::SURE] set res [catch {apply $lambda x} msg] list $res $msg } {1 {cannot find namespace "::::NONEXIST::FOR::SURE"}} test apply-3.2 {non-existing namespace} { namespace eval ::NONEXIST::FOR::SURE {} set lambda [list x {set x 1} ::NONEXIST::FOR::SURE] apply $lambda x namespace delete ::NONEXIST set res [catch {apply $lambda x} msg] list $res $msg } {1 {cannot find namespace "::::NONEXIST::FOR::SURE"}} test apply-4.1 {error in arguments to lambda expression} { set lambda [list x {set x 1}] set res [catch {apply $lambda} msg] list $res $msg } {1 {wrong # args: should be "apply {x {set x 1}} x"}} test apply-4.2 {error in arguments to lambda expression} { set lambda [list x {set x 1}] set res [catch {apply $lambda x y} msg] list $res $msg } {1 {wrong # args: should be "apply {x {set x 1}} x"}} # Tests for correct execution; as the implementation is the same as that for # procs, the general functionality is mostly tested elsewhere test apply-5.1 {info level} { set lev [info level] set lambda [list {} {info level}] expr {[apply $lambda] - $lev} } 1 test apply-5.2 {info level} { set lambda [list {} {info level 0}] apply $lambda } {apply {{} {info level 0}}} test apply-5.3 {info level} { set lambda [list args {info level 0}] apply $lambda x y } {apply {args {info level 0}} x y} # Tests for correct namespace scope namespace eval ::testApply { set x 0 proc testApply args {return testApply} } test apply-6.1 {namespace access} { set body {set x 1; set x} list [apply [list args $body ::testApply]] $::testApply::x } {1 0} test apply-6.2 {namespace access} { set body {variable x; set x} list [apply [list args $body ::testApply]] $::testApply::x } {0 0} test apply-6.3 {namespace access} { set body {variable x; set x 1} list [apply [list args $body ::testApply]] $::testApply::x } {1 1} test apply-6.3 {namespace access} { set body {testApply} apply [list args $body ::testApply] } testApply # Tests for correct argument treatment set applyBody { set res {} foreach v [info locals] { if {$v eq "res"} continue lappend res [list $v [set $v]] } set res } test apply-7.1 {args treatment} { apply [list args $applyBody] 1 2 3 } {{args {1 2 3}}} test apply-7.2 {args treatment} { apply [list {x args} $applyBody] 1 2 } {{x 1} {args 2}} test apply-7.3 {args treatment} { apply [list {x args} $applyBody] 1 2 3 } {{x 1} {args {2 3}}} test apply-7.4 {default values} { apply [list {{x 1} {y 2}} $applyBody] } {{x 1} {y 2}} test apply-7.5 {default values} { apply [list {{x 1} {y 2}} $applyBody] 3 4 } {{x 3} {y 4}} test apply-7.6 {default values} { apply [list {{x 1} {y 2}} $applyBody] 3 } {{x 3} {y 2}} test apply-7.7 {default values} { apply [list {x {y 2}} $applyBody] 1 } {{x 1} {y 2}} test apply-7.8 {default values} { apply [list {x {y 2}} $applyBody] 1 3 } {{x 1} {y 3}} test apply-7.9 {default values} { apply [list {x {y 2} args} $applyBody] 1 } {{x 1} {y 2} {args {}}} test apply-7.10 {default values} { apply [list {x {y 2} args} $applyBody] 1 3 } {{x 1} {y 3} {args {}}} # Tests for the avoidance of recompilation # cleanup namespace delete testApply ::tcltest::cleanupTests return