test interp-20.32 {interp invokehidden vs safety} {
catch {interp delete a}
interp create a -safe
interp hide a list
set l ""
lappend l [catch {a eval {interp invokehidden {} list a b c}} msg]
lappend l $msg
interp delete a
set l
} {1 {not allowed to invoke hidden commands from safe interpreter}}
test interp-20.33 {interp invokehidden vs safety} {
catch {interp delete a}
interp create a -safe
interp hide a list
set l ""
lappend l [catch {a eval {interp invokehidden {} list a b c}} msg]
lappend l $msg
lappend l [catch {a invokehidden list a b c} msg]
lappend l $msg
interp delete a
set l
} {1 {not allowed to invoke hidden commands from safe interpreter}\
0 {a b c}}
test interp-20.34 {interp invokehidden vs safety} {
catch {interp delete a}
interp create a -safe
interp create {a b}
interp hide {a b} list
set l ""
lappend l [catch {a eval {interp invokehidden b list a b c}} msg]
lappend l $msg
lappend l [catch {interp invokehidden {a b} list a b c} msg]
lappend l $msg
interp delete a
set l
} {1 {not allowed to invoke hidden commands from safe interpreter}\
0 {a b c}}
test interp-20.35 {invokehidden at local level} {
catch {interp delete a}
interp create a
a eval {
proc p1 {} {
set z 90
a1
set z
}
proc h1 {} {
upvar z z
set z 91
}
}
a hide h1
a alias a1 a1
proc a1 {} {
interp invokehidden a h1
}
set r [interp eval a p1]
interp delete a
set r
} 91
test interp-20.36 {invokehidden at local level} {
catch {interp delete a}
interp create a
a eval {
set z 90
proc p1 {} {
global z
a1
set z
}
proc h1 {} {
upvar z z
set z 91
}
}
a hide h1
a alias a1 a1
proc a1 {} {
interp invokehidden a h1
}
set r [interp eval a p1]
interp delete a
set r
} 91
test interp-20.37 {invokehidden at local level} {
catch {interp delete a}
interp create a
a eval {
proc p1 {} {
a1
set z
}
proc h1 {} {
upvar z z
set z 91
}
}
a hide h1
a alias a1 a1
proc a1 {} {
interp invokehidden a h1
}
set r [interp eval a p1]
interp delete a
set r
} 91
test interp-20.38 {invokehidden at global level} {
catch {interp delete a}
interp create a
a eval {
proc p1 {} {
a1
set z
}
proc h1 {} {
upvar z z
set z 91
}
}
a hide h1
a alias a1 a1
proc a1 {} {
interp invokehidden a -global h1
}
set r [catch {interp eval a p1} msg]
interp delete a
list $r $msg
} {1 {can't read "z": no such variable}}
test interp-20.39 {invokehidden at global level} {
catch {interp delete a}
interp create a
a eval {
proc p1 {} {
global z
a1
set z
}
proc h1 {} {
upvar z z
set z 91
}
}
a hide h1
a alias a1 a1
proc a1 {} {
interp invokehidden a -global h1
}
set r [catch {interp eval a p1} msg]
interp delete a
list $r $msg
} {0 91}
test interp-20.40 {safe, invokehidden at local level} {
catch {interp delete a}
interp create a -safe
a eval {
proc p1 {} {
set z 90
a1
set z
}
proc h1 {} {
upvar z z
set z 91
}
}
a hide h1
a alias a1 a1
proc a1 {} {
interp invokehidden a h1
}
set r [interp eval a p1]
interp delete a
set r
} 91
test interp-20.41 {safe, invokehidden at local level} {
catch {interp delete a}
interp create a -safe
a eval {
set z 90
proc p1 {} {
global z
a1
set z
}
proc h1 {} {
upvar z z
set z 91
}
}
a hide h1
a alias a1 a1
proc a1 {} {
interp invokehidden a h1
}
set r [interp eval a p1]
interp delete a
set r
} 91
test interp-20.42 {safe, invokehidden at local level} {
catch {interp delete a}
interp create a -safe
a eval {
proc p1 {} {
a1
set z
}
proc h1 {} {
upvar z z
set z 91
}
}
a hide h1
a alias a1 a1
proc a1 {} {
interp invokehidden a h1
}
set r [interp eval a p1]
interp delete a
set r
} 91
test interp-20.43 {invokehidden at global level} {
catch {interp delete a}
interp create a
a eval {
proc p1 {} {
a1
set z
}
proc h1 {} {
upvar z z
set z 91
}
}
a hide h1
a alias a1 a1
proc a1 {} {
interp invokehidden a -global h1
}
set r [catch {interp eval a p1} msg]
interp delete a
list $r $msg
} {1 {can't read "z": no such variable}}
test interp-20.44 {invokehidden at global level} {
catch {interp delete a}
interp create a
a eval {
proc p1 {} {
global z
a1
set z
}
proc h1 {} {
upvar z z
set z 91
}
}
a hide h1
a alias a1 a1
proc a1 {} {
interp invokehidden a -global h1
}
set r [catch {interp eval a p1} msg]
interp delete a
list $r $msg
} {0 91}
test interp-20.45 {interp hide vs namespaces} {
catch {interp delete a}
interp create a
a eval {
namespace eval foo {}
proc foo::x {} {}
}
set l [list [catch {interp hide a foo::x} msg] $msg]
interp delete a
set l
} {1 {cannot use namespace qualifiers as hidden commandtoken (rename)}}
test interp-20.46 {interp hide vs namespaces} {
catch {interp delete a}
interp create a
a eval {
namespace eval foo {}
proc foo::x {} {}
}
set l [list [catch {interp hide a foo::x x} msg] $msg]
interp delete a
set l
} {1 {can only hide global namespace commands (use rename then hide)}}
test interp-20.47 {interp hide vs namespaces} {
catch {interp delete a}
interp create a
a eval {
proc x {} {}
}
set l [list [catch {interp hide a x foo::x} msg] $msg]
interp delete a
set l
} {1 {cannot use namespace qualifiers as hidden commandtoken (rename)}}
test interp-20.48 {interp hide vs namespaces} {
catch {interp delete a}
interp create a
a eval {
namespace eval foo {}
proc foo::x {} {}
}
set l [list [catch {interp hide a foo::x bar::x} msg] $msg]
interp delete a
set l
} {1 {cannot use namespace qualifiers as hidden commandtoken (rename)}}
test interp-21.1 {interp hidden} {
interp hidden {}
} ""
test interp-21.2 {interp hidden} {
interp hidden
} ""
test interp-21.3 {interp hidden vs interp hide, interp expose} {
set l ""
lappend l [interp hidden]
interp hide {} pwd
lappend l [interp hidden]
interp expose {} pwd
lappend l [interp hidden]
set l
} {{} pwd {}}
test interp-21.4 {interp hidden} {
catch {interp delete a}
interp create a
set l [interp hidden a]
interp delete a
set l
} ""
test interp-21.5 {interp hidden} {
catch {interp delete a}
interp create -safe a
set l [lsort [interp hidden a]]
interp delete a
set l
} $hidden_cmds
test interp-21.6 {interp hidden vs interp hide, interp expose} {
catch {interp delete a}
interp create a
set l ""
lappend l [interp hidden a]
interp hide a pwd
lappend l [interp hidden a]
interp expose a pwd
lappend l [interp hidden a]
interp delete a
set l
} {{} pwd {}}
test interp-21.7 {interp hidden} {
catch {interp delete a}
interp create a
set l [a hidden]
interp delete a
set l
} ""
test interp-21.8 {interp hidden} {
catch {interp delete a}
interp create a -safe
set l [lsort [a hidden]]
interp delete a
set l
} $hidden_cmds
test interp-21.9 {interp hidden vs interp hide, interp expose} {
catch {interp delete a}
interp create a
set l ""
lappend l [a hidden]
a hide pwd
lappend l [a hidden]
a expose pwd
lappend l [a hidden]
interp delete a
set l
} {{} pwd {}}
test interp-22.1 {testing interp marktrusted} {
catch {interp delete a}
interp create a
set l ""
lappend l [a issafe]
lappend l [a marktrusted]
lappend l [a issafe]
interp delete a
set l
} {0 {} 0}
test interp-22.2 {testing interp marktrusted} {
catch {interp delete a}
interp create a
set l ""
lappend l [interp issafe a]
lappend l [interp marktrusted a]
lappend l [interp issafe a]
interp delete a
set l
} {0 {} 0}
test interp-22.3 {testing interp marktrusted} {
catch {interp delete a}
interp create a -safe
set l ""
lappend l [a issafe]
lappend l [a marktrusted]
lappend l [a issafe]
interp delete a
set l
} {1 {} 0}
test interp-22.4 {testing interp marktrusted} {
catch {interp delete a}
interp create a -safe
set l ""
lappend l [interp issafe a]
lappend l [interp marktrusted a]
lappend l [interp issafe a]
interp delete a
set l
} {1 {} 0}
test interp-22.5 {testing interp marktrusted} {
catch {interp delete a}
interp create a -safe
interp create {a b}
catch {a eval {interp marktrusted b}} msg
interp delete a
set msg
} {"interp marktrusted" can only be invoked from a trusted interpreter}
test interp-22.6 {testing interp marktrusted} {
catch {interp delete a}
interp create a -safe
interp create {a b}
catch {a eval {b marktrusted}} msg
interp delete a
set msg
} {"b marktrusted" can only be invoked from a trusted interpreter}
test interp-22.7 {testing interp marktrusted} {
catch {interp delete a}
interp create a -safe
set l ""
lappend l [interp issafe a]
interp marktrusted a
interp create {a b}
lappend l [interp issafe a]
lappend l [interp issafe {a b}]
interp delete a
set l
} {1 0 0}
test interp-22.8 {testing interp marktrusted} {
catch {interp delete a}
interp create a -safe
set l ""
lappend l [interp issafe a]
interp create {a b}
lappend l [interp issafe {a b}]
interp marktrusted a
interp create {a c}
lappend l [interp issafe a]
lappend l [interp issafe {a c}]
interp delete a
set l
} {1 1 0 0}
test interp-22.9 {testing interp marktrusted} {
catch {interp delete a}
interp create a -safe
set l ""
lappend l [interp issafe a]
interp create {a b}
lappend l [interp issafe {a b}]
interp marktrusted {a b}
lappend l [interp issafe a]
lappend l [interp issafe {a b}]
interp create {a b c}
lappend l [interp issafe {a b c}]
interp delete a
set l
} {1 1 1 0 0}
test interp-23.1 {testing hiding vs aliases} {
catch {interp delete a}
interp create a
set l ""
lappend l [interp hidden a]
a alias bar bar
lappend l [interp aliases a]
lappend l [interp hidden a]
a hide bar
lappend l [interp aliases a]
lappend l [interp hidden a]
a alias bar {}
lappend l [interp aliases a]
lappend l [interp hidden a]
interp delete a
set l
} {{} bar {} bar bar {} {}}
test interp-23.2 {testing hiding vs aliases} {pc || unix} {
catch {interp delete a}
interp create a -safe
set l ""
lappend l [lsort [interp hidden a]]
a alias bar bar
lappend l [interp aliases a]
lappend l [lsort [interp hidden a]]
a hide bar
lappend l [interp aliases a]
lappend l [lsort [interp hidden a]]
a alias bar {}
lappend l [interp aliases a]
lappend l [lsort [interp hidden a]]
interp delete a
set l
} {{cd exec exit fconfigure file glob load open pwd socket source} bar {cd exec exit fconfigure file glob load open pwd socket source} bar {bar cd exec exit fconfigure file glob load open pwd socket source} {} {cd exec exit fconfigure file glob load open pwd socket source}}
test interp-23.3 {testing hiding vs aliases} {macOnly} {
catch {interp delete a}
interp create a -safe
set l ""
lappend l [lsort [interp hidden a]]
a alias bar bar
lappend l [interp aliases a]
lappend l [lsort [interp hidden a]]
a hide bar
lappend l [interp aliases a]
lappend l [lsort [interp hidden a]]
a alias bar {}
lappend l [interp aliases a]
lappend l [lsort [interp hidden a]]
interp delete a
set l
} {{beep cd echo exit fconfigure file glob load ls open pwd socket source} bar {beep cd echo exit fconfigure file glob load ls open pwd socket source} bar {bar beep cd echo exit fconfigure file glob load ls open pwd socket source} {} {beep cd echo exit fconfigure file glob load ls open pwd socket source}}
test interp-24.1 {result resetting on error} {
catch {interp delete a}
interp create a
proc foo args {error $args}
interp alias a foo {} foo
set l [interp eval a {
set l {}
lappend l [catch {foo 1 2 3} msg]
lappend l $msg
lappend l [catch {foo 3 4 5} msg]
lappend l $msg
set l
}]
interp delete a
set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.2 {result resetting on error} {
catch {interp delete a}
interp create a -safe
proc foo args {error $args}
interp alias a foo {} foo
set l [interp eval a {
set l {}
lappend l [catch {foo 1 2 3} msg]
lappend l $msg
lappend l [catch {foo 3 4 5} msg]
lappend l $msg
set l
}]
interp delete a
set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.3 {result resetting on error} {
catch {interp delete a}
interp create a
interp create {a b}
interp eval a {
proc foo args {error $args}
}
interp alias {a b} foo a foo
set l [interp eval {a b} {
set l {}
lappend l [catch {foo 1 2 3} msg]
lappend l $msg
lappend l [catch {foo 3 4 5} msg]
lappend l $msg
set l
}]
interp delete a
set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.4 {result resetting on error} {
catch {interp delete a}
interp create a -safe
interp create {a b}
interp eval a {
proc foo args {error $args}
}
interp alias {a b} foo a foo
set l [interp eval {a b} {
set l {}
lappend l [catch {foo 1 2 3} msg]
lappend l $msg
lappend l [catch {foo 3 4 5} msg]
lappend l $msg
set l
}]
interp delete a
set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.5 {result resetting on error} {
catch {interp delete a}
catch {interp delete b}
interp create a
interp create b
interp eval a {
proc foo args {error $args}
}
interp alias b foo a foo
set l [interp eval b {
set l {}
lappend l [catch {foo 1 2 3} msg]
lappend l $msg
lappend l [catch {foo 3 4 5} msg]
lappend l $msg
set l
}]
interp delete a
set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.6 {result resetting on error} {
catch {interp delete a}
catch {interp delete b}
interp create a -safe
interp create b -safe
interp eval a {
proc foo args {error $args}
}
interp alias b foo a foo
set l [interp eval b {
set l {}
lappend l [catch {foo 1 2 3} msg]
lappend l $msg
lappend l [catch {foo 3 4 5} msg]
lappend l $msg
set l
}]
interp delete a
set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.7 {result resetting on error} {
catch {interp delete a}
interp create a
interp eval a {
proc foo args {error $args}
}
set l {}
lappend l [catch {interp eval a foo 1 2 3} msg]
lappend l $msg
lappend l [catch {interp eval a foo 3 4 5} msg]
lappend l $msg
interp delete a
set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.8 {result resetting on error} {
catch {interp delete a}
interp create a -safe
interp eval a {
proc foo args {error $args}
}
set l {}
lappend l [catch {interp eval a foo 1 2 3} msg]
lappend l $msg
lappend l [catch {interp eval a foo 3 4 5} msg]
lappend l $msg
interp delete a
set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.9 {result resetting on error} {
catch {interp delete a}
interp create a
interp create {a b}
interp eval {a b} {
proc foo args {error $args}
}
interp eval a {
proc foo args {
eval interp eval b foo $args
}
}
set l {}
lappend l [catch {interp eval a foo 1 2 3} msg]
lappend l $msg
lappend l [catch {interp eval a foo 3 4 5} msg]
lappend l $msg
interp delete a
set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.10 {result resetting on error} {
catch {interp delete a}
interp create a -safe
interp create {a b}
interp eval {a b} {
proc foo args {error $args}
}
interp eval a {
proc foo args {
eval interp eval b foo $args
}
}
set l {}
lappend l [catch {interp eval a foo 1 2 3} msg]
lappend l $msg
lappend l [catch {interp eval a foo 3 4 5} msg]
lappend l $msg
interp delete a
set l
} {1 {1 2 3} 1 {3 4 5}}
test interp-24.11 {result resetting on error} {
catch {interp delete a}
interp create a
interp create {a b}
interp eval {a b} {
proc foo args {error $args}
}
interp eval a {
proc foo args {
set l {}
lappend l [catch {eval interp eval b foo $args} msg]
lappend l $msg
lappend l [catch {eval interp eval b foo $args} msg]
lappend l $msg
set l
}
}
set l [interp eval a foo 1 2 3]
interp delete a
set l
} {1 {1 2 3} 1 {1 2 3}}
test interp-24.12 {result resetting on error} {
catch {interp delete a}
interp create a -safe
interp create {a b}
interp eval {a b} {
proc foo args {error $args}
}
interp eval a {
proc foo args {
set l {}
lappend l [catch {eval interp eval b foo $args} msg]
lappend l $msg
lappend l [catch {eval interp eval b foo $args} msg]
lappend l $msg
set l
}
}
set l [interp eval a foo 1 2 3]
interp delete a
set l
} {1 {1 2 3} 1 {1 2 3}}
unset hidden_cmds
test interp-25.1 {testing aliasing of string commands} {
catch {interp delete a}
interp create a
a alias exec foo ;# Relies on exec being a string command!
interp delete a
} ""
# Interps result transmission
test interp-26.1 {result code transmission 1} {knownBug} {
# This test currently fails ! (only ok/error are passed, not the other
# codes). Fixing the code is thus needed... -- dl
# (the only other acceptable result list would be
# {-1 0 1 0 3 4 5} because of the way return -code return(=2) works)
# test that all the possibles error codes from Tcl get passed
catch {interp delete a}
interp create a
interp eval a {proc ret {code} {return -code $code $code}}
set res {}
# use a for so if a return -code break 'escapes' we would notice
for {set code -1} {$code<=5} {incr code} {
lappend res [catch {interp eval a ret $code} msg]
}
interp delete a
set res
} {-1 0 1 2 3 4 5}
test interp-26.2 {result code transmission 2} {knownBug} {
# This test currently fails ! (error is cleared)
# Code fixing is needed... -- dl
# (the only other acceptable result list would be
# {-1 0 1 0 3 4 5} because of the way return -code return(=2) works)
# test that all the possibles error codes from Tcl get passed
set interp [interp create];
proc MyTestAlias {interp args} {
global aliasTrace;
lappend aliasTrace $args;
eval interp invokehidden [list $interp] $args
}
foreach c {return} {
interp hide $interp $c;
interp alias $interp $c {} MyTestAlias $interp $c;
}
interp eval $interp {proc ret {code} {return -code $code $code}}
set res {}
set aliasTrace {}
for {set code -1} {$code<=5} {incr code} {
lappend res [catch {interp eval $interp ret $code} msg]
# list "master bar called ($v) ([namespace current]) ($args)"\
# [interp invokehidden $interp test::bar $args];
# }
# }
# interp eval $i {
# namespace eval foo {
# namespace export *
# variable v foo-slave;
# proc bar {args} {
# variable v;
# return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
# }
# }
# set v root-slave;
# namespace eval test {
# variable v foo-test;
# namespace import ::foo::*;
# }
# }
# set res [list [interp eval $i {namespace eval test {bar test1}}]]
# $i hide test::bar;
# $i alias test::bar mfoo::bar $i;
# set res [concat $res [interp eval $i {test::bar test2}]];
# namespace delete mfoo;
# interp delete $i;
# set res
# } {{slave bar called (foo-slave) (bar test1) (::test) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}
#test interp-27.8 {hiding, namespaces and integrity} {
# namespace eval foo {
# variable v 3;
# proc bar {} {variable v; set v}
# # next command would currently generate an unknown command "bar" error.
# interp hide {} bar;
# }
# namespace delete foo;
# list [catch {interp invokehidden {} foo} msg] $msg;
#} {1 {invalid hidden command name "foo"}}
test interp-28.1 {getting fooled by slave's namespace ?} {