blob: 81d3833a2ba5bbb9a4ac6ee1064fcc6bd9dce603 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
# 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}}
test apply-9.1 {tailcall within apply} {
proc p {y level} {
list [expr {$y * 2}] [expr {$level - [info level]}]
}
apply {{x} {
tailcall p $x [info level]
notreached
}} {4}
} {8 0}
test apply-9.2 {return from apply} {
apply {{x} {
return [expr {$x + 1}]
}} {4}
} {5}
rename p {}
::tcltest::cleanupTests
return
# Local Variables:
# mode: tcl
# fill-column: 78
# End:
|
