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
|
use Tcl;
$| = 1;
# 5.8.0 has an order destroy issue that prevents proper Tcl finalization
my $tests = $] == 5.008 ? 3 : 4;
print "1..$tests\n";
sub foo {
my($clientdata, $interp, @args) = @_;
print "$clientdata->{OK} $args[1]\n";
}
sub foogone {
my($clientdata) = @_;
print "$clientdata->{OK} 3\n";
}
sub bar { "ok 2" }
sub bargone {
print "ok $_[0]\n";
}
$i = new Tcl;
$i->CreateCommand("foo", \&foo, {OK => "ok"}, \&foogone);
$i->CreateCommand("bar", \&bar, 4, \&bargone);
$i->Eval("foo 1");
$i->Eval("puts [bar]");
$i->DeleteCommand("foo");
# final destructor of $i triggers destructor for Tcl proc bar (!5.8.0)
|
