blob: 94aa4f1ef769258a78ea5f1fb2ad4fe05c832856 (
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
|
source testing.tcl
test alias-1.1 "One word alias" {
set x 2
alias newincr incr
newincr x
} {3}
test alias-1.4 "Two word alias" {
alias infoexists info exists
infoexists x
} {1}
test alias-1.5 "Replace alias" {
alias newincr infoexists
newincr x
} {1}
test alias-1.6 "Delete alias" {
rename newincr ""
catch {newincr x}
} {1}
test alias-1.7 "Replace alias with proc" {
proc infoexists {n} {
return yes
}
infoexists any
} {yes}
test alias-1.8 "Replace proc with alias" {
alias infoexists info exists
infoexists any
} {0}
test curry-1.1 "One word curry" {
set x 2
set one [curry incr]
$one x
} {3}
test curry-1.4 "Two word curry" {
set two [curry info exists]
list [$two x] [$two y]
} {1 0}
test curry-1.5 "Delete curry" {
unset one two
collect
} {2}
test local-1.1 "local lambda in eval" {
set x 1
eval {
local set a [lambda {b} { incr b }]
set x [$a $x]
}
list [info procs $a] $x
} {{} 2}
test local-1.2 "local curry in proc" {
proc a {} {
local set p [curry info exists]
set x 1
list $p [$p x] [$p y]
}
lassign [a] p exists_x exists_y
list [info procs $p] $exists_x $exists_y
} {{} 1 0}
test local-1.2 "set local curry in proc" {
proc a {} {
set p [local curry info exists]
set x 1
list $p [$p x] [$p y]
}
lassign [a] p exists_x exists_y
list [info procs $p] $exists_x $exists_y
} {{} 1 0}
test local-1.3 "local alias in proc" {
proc a {} {
local alias p info exists
set x 1
list [p x] [p y]
}
lassign [a] exists_x exists_y
list [info procs p] $exists_x $exists_y
} {{} 1 0}
test local-1.5 "local proc in proc" {
set ::x 1
proc a {} {
local proc b {} { incr ::x }
b
set ::x
}
a
list [info procs b] $::x
} {{} 2}
test local-1.6 "local lambda in lsort" {
lsort -command [local lambda {a b} {string compare $a $b}] {d a f g}
} {a d f g}
test local-1.7 "check no reference procs" {
info procs "<reference*"
} {}
test local-1.8 "local on non-proc" {
list [catch {local set x blah} msg] $msg
} {1 {not a proc: "blah"}}
test local-1.9 "local on existing proc" {
eval {
proc a {b} {incr b}
local function a
set c [lambda b {incr b -1}]
local function $c
lappend result [a 1] [$c 2]
}
list [info procs a] $result
} {{} {2 1}}
|
