summaryrefslogtreecommitdiffstats
path: root/tests/apply.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/apply.test')
-rw-r--r--tests/apply.test95
1 files changed, 74 insertions, 21 deletions
diff --git a/tests/apply.test b/tests/apply.test
index c000c6e..9218847 100644
--- a/tests/apply.test
+++ b/tests/apply.test
@@ -12,7 +12,7 @@
# 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.1 2006/02/01 19:26:02 dgp Exp $
+# RCS: @(#) $Id: apply.test,v 1.2 2006/02/01 20:17:28 msofer Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -87,7 +87,7 @@ 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"}}
+} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
test apply-3.2 {non-existing namespace} {
namespace eval ::NONEXIST::FOR::SURE {}
@@ -96,7 +96,22 @@ test apply-3.2 {non-existing namespace} {
namespace delete ::NONEXIST
set res [catch {apply $lambda x} msg]
list $res $msg
-} {1 {cannot find namespace "::::NONEXIST::FOR::SURE"}}
+} {1 {cannot find namespace "::NONEXIST::FOR::SURE"}}
+
+test apply-3.3 {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}]
@@ -110,21 +125,32 @@ test apply-4.2 {error in arguments to lambda expression} {
list $res $msg
} {1 {wrong # args: should be "apply {x {set x 1}} x"}}
+test apply-5.1 {runtime error in lambda expression} {
+ set lambda [list {} {error foo}]
+ set res [catch {apply $lambda}]
+ list $res $errorInfo
+} {1 {foo
+ while executing
+"error foo"
+ (procedure "apply" line 1) CHECK & MODIFY
+ invoked from within
+"apply $lambda"}}
+
# 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} {
+test apply-6.1 {info level} {
set lev [info level]
set lambda [list {} {info level}]
expr {[apply $lambda] - $lev}
} 1
-test apply-5.2 {info level} {
+test apply-6.2 {info level} {
set lambda [list {} {info level 0}]
apply $lambda
} {apply {{} {info level 0}}}
-test apply-5.3 {info level} {
+test apply-6.3 {info level} {
set lambda [list args {info level 0}]
apply $lambda x y
} {apply {args {info level 0}} x y}
@@ -132,30 +158,57 @@ test apply-5.3 {info level} {
# Tests for correct namespace scope
namespace eval ::testApply {
- set x 0
proc testApply args {return testApply}
}
-test apply-6.1 {namespace access} {
+test apply-7.1 {namespace access} {
+ set ::testApply::x 0
set body {set x 1; set x}
list [apply [list args $body ::testApply]] $::testApply::x
} {1 0}
-test apply-6.2 {namespace access} {
+test apply-7.2 {namespace access} {
+ set ::testApply::x 0
set body {variable x; set x}
list [apply [list args $body ::testApply]] $::testApply::x
} {0 0}
-test apply-6.3 {namespace access} {
+test apply-7.3 {namespace access} {
+ set ::testApply::x 0
set body {variable x; set x 1}
list [apply [list args $body ::testApply]] $::testApply::x
} {1 1}
-test apply-6.3 {namespace access} {
+test apply-7.4 {namespace access} {
+ set ::testApply::x 0
set body {testApply}
apply [list args $body ::testApply]
} testApply
+test apply-7.5 {namespace access} {
+ set ::testApply::x 0
+ set body {set x 1; set x}
+ list [apply [list args $body testApply]] $::testApply::x
+} {1 0}
+
+test apply-7.6 {namespace access} {
+ set ::testApply::x 0
+ set body {variable x; set x}
+ list [apply [list args $body testApply]] $::testApply::x
+} {0 0}
+
+test apply-7.7 {namespace access} {
+ set ::testApply::x 0
+ set body {variable x; set x 1}
+ list [apply [list args $body testApply]] $::testApply::x
+} {1 1}
+
+test apply-7.8 {namespace access} {
+ set ::testApply::x 0
+ set body {testApply}
+ apply [list args $body testApply]
+} testApply
+
# Tests for correct argument treatment
@@ -168,43 +221,43 @@ set applyBody {
set res
}
-test apply-7.1 {args treatment} {
+test apply-8.1 {args treatment} {
apply [list args $applyBody] 1 2 3
} {{args {1 2 3}}}
-test apply-7.2 {args treatment} {
+test apply-8.2 {args treatment} {
apply [list {x args} $applyBody] 1 2
} {{x 1} {args 2}}
-test apply-7.3 {args treatment} {
+test apply-8.3 {args treatment} {
apply [list {x args} $applyBody] 1 2 3
} {{x 1} {args {2 3}}}
-test apply-7.4 {default values} {
+test apply-8.4 {default values} {
apply [list {{x 1} {y 2}} $applyBody]
} {{x 1} {y 2}}
-test apply-7.5 {default values} {
+test apply-8.5 {default values} {
apply [list {{x 1} {y 2}} $applyBody] 3 4
} {{x 3} {y 4}}
-test apply-7.6 {default values} {
+test apply-8.6 {default values} {
apply [list {{x 1} {y 2}} $applyBody] 3
} {{x 3} {y 2}}
-test apply-7.7 {default values} {
+test apply-8.7 {default values} {
apply [list {x {y 2}} $applyBody] 1
} {{x 1} {y 2}}
-test apply-7.8 {default values} {
+test apply-8.8 {default values} {
apply [list {x {y 2}} $applyBody] 1 3
} {{x 1} {y 3}}
-test apply-7.9 {default values} {
+test apply-8.9 {default values} {
apply [list {x {y 2} args} $applyBody] 1
} {{x 1} {y 2} {args {}}}
-test apply-7.10 {default values} {
+test apply-8.10 {default values} {
apply [list {x {y 2} args} $applyBody] 1 3
} {{x 1} {y 3} {args {}}}