| ︙ | | | ︙ | |
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
foreach v $args {
upvar $v var
return "variable $v existence: [info exists var]"
}
}
foo a
eval [info body foo]
} -returnCodes error -result {can't read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} {
proc foo args [list subst bar]
list [string length [info body foo]] \
[foo; string length [info body foo]]
|
|
|
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
foreach v $args {
upvar $v var
return "variable $v existence: [info exists var]"
}
}
foo a
eval [info body foo]
} -returnCodes error -result {cannot read "args": no such variable}
# Fix for problem tested for in info-2.5 caused problems when
# procedure body had no string rep (i.e. was not yet bytecode)
# causing an empty string to be returned [Bug #545644]
test info-2.6 {info body option, returning list bodies} {
proc foo args [list subst bar]
list [string length [info body foo]] \
[foo; string length [info body foo]]
|
| ︙ | | | ︙ | |
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
} -result {procedure "t1" doesn't have an argument "x"}
test info-6.9 {info default option} -returnCodes error -setup {
catch {unset a}
} -cleanup {unset a} -body {
set a(0) 88
proc t1 {a b} {}
info default t1 a a
} -returnCodes error -result {can't set "a": variable is array}
test info-6.10 {info default option} -setup {
catch {unset a}
} -cleanup {unset a} -body {
set a(0) 88
proc t1 {{a 18} b} {}
info default t1 a a
} -returnCodes error -result {can't set "a": variable is array}
test info-6.11 {info default option} {
catch {namespace delete test_ns_info2}
namespace eval test_ns_info2 {
namespace import ::test_ns_info1::*
list [info default p x foo] $foo [info default q y bar] $bar
}
} {0 {} 1 27}
|
|
|
|
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
|
} -result {procedure "t1" doesn't have an argument "x"}
test info-6.9 {info default option} -returnCodes error -setup {
catch {unset a}
} -cleanup {unset a} -body {
set a(0) 88
proc t1 {a b} {}
info default t1 a a
} -returnCodes error -result {cannot set "a": variable is array}
test info-6.10 {info default option} -setup {
catch {unset a}
} -cleanup {unset a} -body {
set a(0) 88
proc t1 {{a 18} b} {}
info default t1 a a
} -returnCodes error -result {cannot set "a": variable is array}
test info-6.11 {info default option} {
catch {namespace delete test_ns_info2}
namespace eval test_ns_info2 {
namespace import ::test_ns_info1::*
list [info default p x foo] $foo [info default q y bar] $bar
}
} {0 {} 1 27}
|
| ︙ | | | ︙ | |
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
|
test info-14.3 {info patchlevel option} -setup {
set t $tcl_patchLevel
} -body {
unset tcl_patchLevel
info patchlevel
} -cleanup {
set tcl_patchLevel $t; unset t
} -returnCodes error -result {can't read "tcl_patchLevel": no such variable}
test info-15.1 {info procs option} -body {
proc t1 {} {}
proc t2 {} {}
set x " [info procs] "
list [string match {* t1 *} $x] [string match {* t2 *} $x] \
[string match {* _undefined_ *} $x]
|
|
|
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
|
test info-14.3 {info patchlevel option} -setup {
set t $tcl_patchLevel
} -body {
unset tcl_patchLevel
info patchlevel
} -cleanup {
set tcl_patchLevel $t; unset t
} -returnCodes error -result {cannot read "tcl_patchLevel": no such variable}
test info-15.1 {info procs option} -body {
proc t1 {} {}
proc t2 {} {}
set x " [info procs] "
list [string match {* t1 *} $x] [string match {* t2 *} $x] \
[string match {* _undefined_ *} $x]
|
| ︙ | | | ︙ | |
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
|
test info-18.3 {info tclversion option} -body {
unset tcl_version
info tclversion
} -returnCodes error -setup {
set t $tcl_version
} -cleanup {
set tcl_version $t; unset t
} -result {can't read "tcl_version": no such variable}
test info-19.1 {info vars option} -body {
set a 1
set b 2
proc t1 {x y} {
global a b
set c 33
|
|
|
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
|
test info-18.3 {info tclversion option} -body {
unset tcl_version
info tclversion
} -returnCodes error -setup {
set t $tcl_version
} -cleanup {
set tcl_version $t; unset t
} -result {cannot read "tcl_version": no such variable}
test info-19.1 {info vars option} -body {
set a 1
set b 2
proc t1 {x y} {
global a b
set c 33
|
| ︙ | | | ︙ | |