mirror of
https://github.com/percona/percona-toolkit.git
synced 2025-09-11 13:40:07 +00:00
Fix for 1073532: Mo doesn't work with Scalar::Util::PP
Unlike Scalar::Util, Scalar::Util::PP::looks_like_number shifts @_, so calling it as &looks_like_number works differently in both versions; see https://rt.cpan.org/Public/Bug/Display.html?id=80525
This commit is contained in:
14
lib/Mo.pm
14
lib/Mo.pm
@@ -41,19 +41,19 @@ use strict;
|
||||
use warnings qw( FATAL all );
|
||||
|
||||
use Carp ();
|
||||
use Scalar::Util ();
|
||||
use Scalar::Util qw(looks_like_number blessed);
|
||||
|
||||
# Basic types for isa. If you want a new type, either add it here,
|
||||
# or give isa a coderef.
|
||||
|
||||
our %TYPES = (
|
||||
Bool => sub { !$_[0] || (defined $_[0] && &Scalar::Util::looks_like_number && $_[0] == 1) },
|
||||
Num => sub { defined $_[0] && &Scalar::Util::looks_like_number },
|
||||
Int => sub { defined $_[0] && &Scalar::Util::looks_like_number && $_[0] == int $_[0] },
|
||||
Bool => sub { !$_[0] || (defined $_[0] && looks_like_number($_[0]) && $_[0] == 1) },
|
||||
Num => sub { defined $_[0] && looks_like_number($_[0]) },
|
||||
Int => sub { defined $_[0] && looks_like_number($_[0]) && $_[0] == int($_[0]) },
|
||||
Str => sub { defined $_[0] },
|
||||
Object => sub { defined $_[0] && &Scalar::Util::blessed },
|
||||
Object => sub { defined $_[0] && blessed($_[0]) },
|
||||
FileHandle => sub { local $@; require IO::Handle; fileno($_[0]) && $_[0]->opened },
|
||||
|
||||
# Ref types:
|
||||
map {
|
||||
my $type = /R/ ? $_ : uc $_;
|
||||
$_ . "Ref" => sub { ref $_[0] eq $type }
|
||||
@@ -245,7 +245,7 @@ sub Mo::import {
|
||||
$method = sub {
|
||||
if ( $#_ ) {
|
||||
Carp::confess(qq<Attribute ($attribute) doesn't consume a '$role' role">)
|
||||
unless blessed($_[1]) && $_[1]->does($role)
|
||||
unless Scalar::Util::blessed($_[1]) && eval { $_[1]->does($role) }
|
||||
}
|
||||
goto &$original_method
|
||||
};
|
||||
|
@@ -9,6 +9,7 @@ BEGIN {
|
||||
use strict;
|
||||
use warnings FATAL => 'all';
|
||||
use English qw(-no_match_vars);
|
||||
use PerconaTest ();
|
||||
use Test::More;
|
||||
|
||||
sub dies_ok (&;$) {
|
||||
@@ -182,4 +183,19 @@ for my $type (@types[1..$#types]) {
|
||||
my $method = "my$type";
|
||||
dies_ok { $foo->$method(undef) } "$type attr set to undef dies" }
|
||||
|
||||
|
||||
use Config;
|
||||
use File::Spec;
|
||||
use IPC::Cmd ();
|
||||
my $thisperl = $^X;
|
||||
if ($^O ne 'VMS')
|
||||
{$thisperl .= $Config{_exe} unless $thisperl =~ m/$Config{_exe}$/i;}
|
||||
|
||||
my $pm_test = File::Spec->catfile($PerconaTest::trunk, qw(t lib Mo isa_subtest.pm));
|
||||
|
||||
ok(
|
||||
scalar(IPC::Cmd::run(command => [$thisperl, $pm_test])),
|
||||
"Mo types work with Scalar::Util::PP",
|
||||
);
|
||||
|
||||
done_testing;
|
||||
|
28
t/lib/Mo/isa_subtest.pm
Normal file
28
t/lib/Mo/isa_subtest.pm
Normal file
@@ -0,0 +1,28 @@
|
||||
BEGIN {
|
||||
require Scalar::Util::PP;
|
||||
*Scalar::Util:: = \*Scalar::Util::PP::;
|
||||
$INC{"Scalar/Util.pm"} = __FILE__;
|
||||
};
|
||||
|
||||
BEGIN {
|
||||
die "The PERCONA_TOOLKIT_BRANCH environment variable is not set.\n"
|
||||
unless $ENV{PERCONA_TOOLKIT_BRANCH} && -d $ENV{PERCONA_TOOLKIT_BRANCH};
|
||||
unshift @INC, "$ENV{PERCONA_TOOLKIT_BRANCH}/lib";
|
||||
};
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
{
|
||||
package isa_subtest;
|
||||
use Mo;
|
||||
|
||||
has attr => (
|
||||
is => 'rw',
|
||||
isa => 'Int',
|
||||
);
|
||||
|
||||
1;
|
||||
}
|
||||
|
||||
isa_subtest->new(attr => 100);
|
Reference in New Issue
Block a user