Skip to content

Commit

Permalink
Move hrefaddr to DBIC::_Util, give most functions a prototype
Browse files Browse the repository at this point in the history
This way we can safely do e.g. ( hrefaddr $foo, $unrelated_bar )
  • Loading branch information
ribasushi committed Jan 23, 2014
1 parent 841efcb commit bf30289
Show file tree
Hide file tree
Showing 3 changed files with 15 additions and 15 deletions.
20 changes: 11 additions & 9 deletions lib/DBIx/Class/_Util.pm
Expand Up @@ -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';
Expand All @@ -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;
Expand All @@ -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 '
Expand All @@ -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,
Expand All @@ -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"
Expand Down Expand Up @@ -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');
}

Expand Down
4 changes: 2 additions & 2 deletions t/52leaks.t
Expand Up @@ -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;
Expand Down
6 changes: 2 additions & 4 deletions t/lib/DBICTest/Util/LeakTracer.pm
Expand Up @@ -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';
Expand All @@ -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)',
Expand Down

0 comments on commit bf30289

Please sign in to comment.