#! /bin/env tclsh
package require {ycl test}
proc suite_main {} {
global auto_path
package require {ycl proc}
[yclprefix] proc alias [yclprefix]::proc::alias
alias aliases [yclprefix]::proc::aliases
aliases {
{ycl list} {
join
sl
}
{ycl ns local} {
rename
set
}
{ycl var}
}
[yclprefix]::test::init
rename test {}
aliases {
{ycl test} {
test
}
}
alias [yclprefix]::test::cleanup1
package require {ycl test data}
lappend setup1 [list set auto_path $auto_path]
lappend setup1 {
package require {ycl proc}
[yclprefix] proc alias [yclprefix]::proc::alias
alias aliases [yclprefix]::proc::aliases
aliases {
{ycl list} {
sl
}
{ycl ns local} {
set
}
{ycl var}
}
package require {ycl ns join}
alias nsjoin [yclprefix] ns join
set script1 {
::set a 5
var constant a
lappend res $a
catch {set a 7} cres
set match [
string match {can't set "*a": {read-only variable} *a} $cres]
lappend res read-only $match
unset a
set a 11
lappend res $a
return $res
}
}
join setup1 \n
foreach {type action} [list local try namespace [string trim {
namespace eval [namespace current]
}]] {
try [string map [list @action@ $action] {
test constant_$type {} -setup $setup1 -body {
@action@ $script1
} -cleanup [cleanup1] -result [sl {
5 read-only 1 11
}]
}]
}
test $ {} -setup $setup1 -body {
set [nsjoin {} var1] 13
set [nsjoin [namespace current] var1] 5
lappend res [var $ var1]
lappend res [var $ {} var1]
return $res
} -cleanup [cleanup1] -result [sl {
5 13
}]
test let {} -setup $setup1 -body {
variable res
namespace eval ns1 {
namespace upvar [namespace parent] res res
namespace path [namespace parent]
set res {}
variable c 4
proc p1 {} {
variable a
variable c
variable res
set b 3
set d 5
set f 17
set unique [var let a {c b} {e c} d {f f pass 0} {
lappend res [info exists f]
lappend res [expr {$c + $e + $d}]
return $res
}]
lappend res $a
set d 6
lappend res $a
set res1 [var letinfo $unique]
foreach {key val} $res1 {
dict unset val pass
dict set res1 $key $val
}
lappend res $res1
p2
}
proc p2 {} {
variable a
variable res
set b 11
set c 13
set d 18
lappend res $a
}
p1
if 0 {
in p1
$a depended on local variables so when p1 ends $a should no
longer be managed by [let]
}
catch {p2} cres
lappend res $cres
}
set expected [sl {
{0 12} {0 13} [sl {
c {target b get {::uplevel #3 {::set b}} value 3 changes 0}
e [sl {target [namespace current]::ns1::c get [
list ::set ::ycltestrun313::ns1::c] value 4 changes 0}]
d {target d get {::uplevel #3 {::set d}} value 6 changes 1}
f {target f get {::uplevel #3 {::set f}} value 17 changes 0}
}]
{0 13}
{can't read "a": no such variable}
}]
if {$res eq $expected} {
return 1
} else {
set res2 expected
append res2 \n$expected
append res2 \ngot\n$res
return $res2
}
} -cleanup [cleanup1] -result 1
test letarray {} -setup $setup1 -body {
namespace eval ns1 {
namespace path [namespace parent]
set res {}
proc p1 {} {
upvar res res
array set vals [list ) 3]
set vals(c) 4
set d 5
set unique [var let a {c {vals )}} {e vals(c)} d {
expr {$c + $e + $d}
}]
lappend res $a
set d 6
lappend res $a
set info [var letinfo $unique]
foreach key [dict keys $info] {
dict unset info $key get
dict unset info $key pass
}
lappend res $info
}
p1
return $res
}
} -cleanup [cleanup1] -result [sl {
12 13 [sl {
c {target {vals )} value 3 changes 0}
e {target vals(c) value 4 changes 0}
d {target d value 6 changes 1}
}]
}]
cleanupTests
}