| Subject: | suggest descend into tied() of scalar/array/hash/filehandle |
| Date: | Tue, 07 Apr 2009 08:43:21 +1000 |
| To: | bug-Test-Weaken [...] rt.cpan.org |
| From: | Kevin Ryde <user42 [...] zip.com.au> |
It'd be good if Test::Weaken looked at tied() to notice the object
associated with a tied scalar, array, hash or filehandle. That tie
object should in most cases have the same lifespan as the variable and
so could be helpfully included in the weakening (recursively as usual).
Some possible exercise for such a feature below.
#!/usr/bin/perl
package MyTie;
use strict;
use warnings;
my $leaky;
sub TIESCALAR {
my ($class) = @_;
my $tobj = bless {}, $class;
$leaky = $tobj;
return $tobj;
}
sub TIEHASH {
goto \&TIESCALAR;
}
sub FIRSTKEY {
return; # no keys
}
sub TIEARRAY {
goto \&TIESCALAR;
}
sub FETCHSIZE {
return 0; # no array elements
}
sub TIEHANDLE {
goto \&TIESCALAR;
}
package main;
use strict;
use warnings;
use Test::Weaken;
use Test::More tests => 4;
{
my $test = Test::Weaken::leaks
(sub {
my $var;
tie $var, 'MyTie';
return \$var;
});
my $unfreed_count = $test ? $test->unfreed_count() : 0;
is ($unfreed_count, 1, 'notice scalar tied() not freed');
}
{
my $test = Test::Weaken::leaks
(sub {
my %var;
tie %var, 'MyTie';
return \%var;
});
my $unfreed_count = $test ? $test->unfreed_count() : 0;
is ($unfreed_count, 1, 'notice hash tied() not freed');
}
{
my $test = Test::Weaken::leaks
(sub {
my @var;
tie @var, 'MyTie';
return \@var;
});
my $unfreed_count = $test ? $test->unfreed_count() : 0;
is ($unfreed_count, 1, 'notice array tied() not freed');
}
{
my $test = Test::Weaken::leaks
(sub {
tie *MYFILEHANDLE, 'MyTie';
return \*MYFILEHANDLE;
});
my $unfreed_count = $test ? $test->unfreed_count() : 0;
is ($unfreed_count, 1, 'notice file handle typeglob tied() not freed');
}
exit 0;