summaryrefslogtreecommitdiffstats
path: root/tests/apply.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/apply.test')
-rw-r--r--tests/apply.test38
1 files changed, 3 insertions, 35 deletions
diff --git a/tests/apply.test b/tests/apply.test
index e639638..10131ce 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.8 2006/10/24 23:13:07 msofer Exp $
+# RCS: @(#) $Id: apply.test,v 1.9 2006/10/28 22:48:43 dkf Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -23,7 +23,7 @@ if {[info commands ::apply] eq {}} {
return
}
-testConstraint memory [llength [info commands memory]]
+testConstraint memory [llength [info commands memory]]
# Tests for wrong number of arguments
@@ -39,13 +39,11 @@ test apply-2.0 {malformed lambda} {
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]
@@ -54,7 +52,6 @@ test apply-2.2 {malformed lambda} {
(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]
@@ -63,7 +60,6 @@ test apply-2.3 {malformed lambda} {
(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]
@@ -72,7 +68,6 @@ test apply-2.4 {malformed lambda} {
(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]
@@ -82,7 +77,6 @@ test apply-2.5 {malformed lambda} {
invoked from within
"apply $lambda"}}
-
# Tests for runtime errors in the lambda expression
test apply-3.1 {non-existing namespace} {
@@ -90,7 +84,6 @@ test apply-3.1 {non-existing namespace} {
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]
@@ -99,13 +92,11 @@ test apply-3.2 {non-existing namespace} {
set res [catch {apply $lambda x} msg]
list $res $msg
} {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.4 {non-existing namespace} {
namespace eval ::NONEXIST::FOR::SURE {}
set lambda [list x {set x 1} NONEXIST::FOR::SURE]
@@ -120,27 +111,23 @@ test apply-4.1 {error in arguments to lambda expression} {
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 a b} msg]
list $res $msg
} {1 {wrong # args: should be "apply {x {set x 1}} x"}}
-
test apply-4.3 {error in arguments to lambda expression} {
set lambda [list x {set x 1}]
interp alias {} foo {} ::apply $lambda
set res [catch {foo a b} msg]
list $res $msg [rename foo {}]
} {1 {wrong # args: should be "foo x"} {}}
-
test apply-4.4 {error in arguments to lambda expression} {
set lambda [list x {set x 1}]
interp alias {} foo {} ::apply $lambda a
set res [catch {foo b} msg]
list $res $msg [rename foo {}]
} {1 {wrong # args: should be "foo"} {}}
-
test apply-4.5 {error in arguments to lambda expression} {
set lambda [list x {set x 1}]
namespace eval a {
@@ -168,7 +155,7 @@ test apply-5.1 {runtime error in lambda expression} {
} {1 {foo
while executing
"error foo"
- (procedure "apply {{} {error foo}}" line 1)
+ (lambda term "{} {error foo}" line 1)
invoked from within
"apply $lambda"}}
@@ -180,12 +167,10 @@ test apply-6.1 {info level} {
set lambda [list {} {info level}]
expr {[apply $lambda] - $lev}
} 1
-
test apply-6.2 {info level} {
set lambda [list {} {info level 0}]
apply $lambda
} {apply {{} {info level 0}}}
-
test apply-6.3 {info level} {
set lambda [list args {info level 0}]
apply $lambda x y
@@ -202,50 +187,42 @@ test apply-7.1 {namespace access} {
set body {set x 1; set x}
list [apply [list args $body ::testApply]] $::testApply::x
} {1 0}
-
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-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-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
set applyBody {
@@ -260,39 +237,30 @@ set applyBody {
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
} {{x 1} {args 2}}
-
test apply-8.3 {args treatment} {
apply [list {x args} $applyBody] 1 2 3
} {{x 1} {args {2 3}}}
-
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
} {{x 1} {y 2} {args {}}}
-
test apply-8.10 {default values} {
apply [list {x {y 2} args} $applyBody] 1 3
} {{x 1} {y 3} {args {}}}
generated by cgit v0.12 at 2024-11-06 22:53:04 (GMT)