use Carp;
use Scalar::Util qw/isweak weaken blessed reftype refaddr/;
+use Config;
use base 'Exporter';
-our @EXPORT_OK = qw/stacktrace populate_weakregistry assert_empty_weakregistry/;
+our @EXPORT_OK = qw/local_umask stacktrace populate_weakregistry assert_empty_weakregistry/;
+
+sub local_umask {
+ return unless defined $Config{d_umask};
+
+ die 'Calling local_umask() in void context makes no sense'
+ if ! defined wantarray;
+
+ my $old_umask = umask(shift());
+ die "Setting umask failed: $!" unless defined $old_umask;
+
+ return bless \$old_umask, 'DBICTest::Util::UmaskGuard';
+}
+{
+ package DBICTest::Util::UmaskGuard;
+ sub DESTROY {
+ local ($@, $!);
+ eval { defined (umask ${$_[0]}) or die };
+ warn ( "Unable to reset old umask ${$_[0]}: " . ($!||'Unknown error') )
+ if ($@ || $!);
+ }
+}
+
sub stacktrace {
my $frame = shift;
return join "\tinvoked as ", map { sprintf ("%s at %s line %d\n", @$_ ) } @stack;
}
+my $refs_traced = 0;
sub populate_weakregistry {
my ($reg, $target, $slot) = @_;
-
croak 'Target is not a reference' unless defined ref $target;
$slot ||= (sprintf '%s%s(0x%x)', # so we don't trigger stringification
refaddr $target,
);
- weaken( $reg->{$slot}{weakref} = $target );
- $reg->{$slot}{stacktrace} = stacktrace(1);
+ if (defined $reg->{$slot}{weakref}) {
+ if ( refaddr($reg->{$slot}{weakref}) != (refaddr $target) ) {
+ print STDERR "Bail out! Weak Registry slot collision: $reg->{$slot}{weakref} / $target\n";
+ exit 255;
+ }
+ }
+ else {
+ $refs_traced++;
+ weaken( $reg->{$slot}{weakref} = $target );
+ $reg->{$slot}{stacktrace} = stacktrace(1);
+ }
$target;
}
}
END {
- if ($leaks_found) {
+ if ($INC{'Test/Builder.pm'}) {
my $tb = Test::Builder->new;
- $tb->diag(sprintf
- "\n\n%s\n%s\n\nInstall Devel::FindRef and re-run the test with set "
- . '$ENV{TEST_VERBOSE} (prove -v) to see a more detailed leak-report'
- . "\n\n%s\n%s\n\n", ('#' x 16) x 4
- ) if (!$tb->is_passing and (!$ENV{TEST_VERBOSE} or !$INC{'Devel/FindRef.pm'}));
+
+ # we check for test passage - a leak may be a part of a TODO
+ if ($leaks_found and !$tb->is_passing) {
+
+ $tb->diag(sprintf
+ "\n\n%s\n%s\n\nInstall Devel::FindRef and re-run the test with set "
+ . '$ENV{TEST_VERBOSE} (prove -v) to see a more detailed leak-report'
+ . "\n\n%s\n%s\n\n", ('#' x 16) x 4
+ ) if ( !$ENV{TEST_VERBOSE} or !$INC{'Devel/FindRef.pm'} );
+
+ }
+ else {
+ $tb->note("Auto checked $refs_traced references for leaks - none detected");
+ }
}
}