use Tcl;
$| = 1;
print "1..8\n";
sub foo {
my $interp = $_[1];
my $glob = $interp->GetVar("bar", Tcl::GLOBAL_ONLY);
my $loc = $interp->GetVar("bar");
print "$glob $loc\n";
$interp->Eval('puts $four', Tcl::EVAL_GLOBAL);
}
$i = new Tcl;
$i->SetVar("foo", "ok 1");
$i->Eval('puts $foo');
$i->Eval('set foo "ok 2\n"');
print $i->GetVar("foo");
$i->CreateCommand("foo", \&foo);
$i->Eval(<<'EOT');
set bar ok
set four "ok 4"
proc baz {} {
set bar 3
set four "not ok 4"
foo
}
baz
EOT
$i->Eval('set a(OK) ok; set a(five) 5');
$ok = $i->GetVar2("a", "OK");
$five = $i->GetVar2("a", "five");
print "$ok $five\n";
print defined($i->GetVar("nonesuch")) ? "not ok 6\n" : "ok 6\n";
# some Unicode tests
if ($]>=5.006 && $i->GetVar("tcl_version")>=8.1) {
$i->SetVar("univar","\x{abcd}\x{1234}");
if ($i->GetVar("univar") ne "\x{abcd}\x{1234}") {
print "not ";
}
print "ok 7 # Unicode persistence during [SG]etVar\n";
my $r;
tie $r, Tcl::Var, $i, "perl_r";
$r = "\x{abcd}\x{1234}";
if ($r ne "\x{abcd}\x{1234}") {
print "not ";
}
print "ok 8 # Unicode persistence for tied variable\n";
binmode(STDOUT, ":utf8") if $] >= 5.008;
print "# $r\n";
}
else {
for (7..8) {print "ok $_ # skipped: not Unicode-aware Perl or Tcl\n";}
}