diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm index 6b8f87c1b..60e040961 100644 --- a/lib/DBIx/Class/_Util.pm +++ b/lib/DBIx/Class/_Util.pm @@ -54,12 +54,12 @@ BEGIN { use DBIx::Class::Carp '^DBIx::Class|^DBICTest'; use Carp 'croak'; -use Scalar::Util qw(refaddr weaken blessed reftype); +use Scalar::Util qw(weaken blessed reftype); use base 'Exporter'; -our @EXPORT_OK = qw(sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray refcount is_exception); +our @EXPORT_OK = qw(sigwarn_silencer modver_gt_or_eq fail_on_internal_wantarray refcount hrefaddr is_exception); -sub sigwarn_silencer { +sub sigwarn_silencer ($) { my $pattern = shift; croak "Expecting a regexp" if ref $pattern ne 'Regexp'; @@ -69,7 +69,9 @@ sub sigwarn_silencer { return sub { &$orig_sig_warn unless $_[0] =~ $pattern }; } -sub refcount { +sub hrefaddr ($) { sprintf '0x%x', &Scalar::Util::refaddr } + +sub refcount ($) { croak "Expecting a reference" if ! length ref $_[0]; require B; @@ -93,7 +95,7 @@ sub is_exception ($) { if (defined $suberror) { if (length (my $class = blessed($e) )) { carp_unique( sprintf( - 'External exception object %s=%s(0x%x) implements partial (broken) ' + 'External exception object %s=%s(%s) implements partial (broken) ' . 'overloading preventing it from being used in simple ($x eq $y) ' . 'comparisons. Given Perl\'s "globally cooperative" exception ' . 'handling this type of brokenness is extremely dangerous on ' @@ -107,7 +109,7 @@ sub is_exception ($) { . "as generated by Perl itself:\n\n%s\n ", $class, reftype $e, - refaddr $e, + hrefaddr $e, $class, 'http://v.gd/DBIC_overload_tempfix/', $suberror, @@ -126,7 +128,7 @@ sub is_exception ($) { return $not_blank; } -sub modver_gt_or_eq { +sub modver_gt_or_eq ($$) { my ($mod, $ver) = @_; croak "Nonsensical module name supplied" @@ -174,8 +176,8 @@ sub modver_gt_or_eq { my $obj = shift; DBIx::Class::Exception->throw( sprintf ( - "Improper use of %s(0x%x) instance in list context at %s line %d\n\n\tStacktrace starts", - ref($obj), refaddr($obj), (caller($cf))[1,2] + "Improper use of %s(%s) instance in list context at %s line %d\n\n\tStacktrace starts", + ref($obj), hrefaddr($obj), (caller($cf))[1,2] ), 'with_stacktrace'); } diff --git a/t/52leaks.t b/t/52leaks.t index aefe40c2c..e5d498a5d 100644 --- a/t/52leaks.t +++ b/t/52leaks.t @@ -47,10 +47,10 @@ if ($ENV{DBICTEST_IN_PERSISTENT_ENV}) { use lib qw(t/lib); use DBICTest::RunMode; -use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs hrefaddr); +use DBICTest::Util::LeakTracer qw(populate_weakregistry assert_empty_weakregistry visit_refs); use Scalar::Util qw(weaken blessed reftype); use DBIx::Class; -use DBIx::Class::_Util 'sigwarn_silencer'; +use DBIx::Class::_Util qw(hrefaddr sigwarn_silencer); BEGIN { plan skip_all => "Your perl version $] appears to leak like a sieve - skipping test" if DBIx::Class::_ENV_::PEEPEENESS; diff --git a/t/lib/DBICTest/Util/LeakTracer.pm b/t/lib/DBICTest/Util/LeakTracer.pm index 718a0aad3..b3984b60f 100644 --- a/t/lib/DBICTest/Util/LeakTracer.pm +++ b/t/lib/DBICTest/Util/LeakTracer.pm @@ -5,7 +5,7 @@ use strict; use Carp; use Scalar::Util qw(isweak weaken blessed reftype); -use DBIx::Class::_Util 'refcount'; +use DBIx::Class::_Util qw(refcount hrefaddr); use DBIx::Class::Optional::Dependencies; use Data::Dumper::Concise; use DBICTest::Util 'stacktrace'; @@ -15,14 +15,12 @@ use constant { }; use base 'Exporter'; -our @EXPORT_OK = qw(populate_weakregistry assert_empty_weakregistry hrefaddr visit_refs); +our @EXPORT_OK = qw(populate_weakregistry assert_empty_weakregistry visit_refs); my $refs_traced = 0; my $leaks_found = 0; my %reg_of_regs; -sub hrefaddr { sprintf '0x%x', &Scalar::Util::refaddr } - # so we don't trigger stringification sub _describe_ref { sprintf '%s%s(%s)',