Bug #87649 for Params-Util: _CLASS cannot be called with $1

On Tue Aug 06 09:13:55 2013, vsespb wrote: Show quoted text
The attached patches test and fix this issue. Comments welcome. Cheers, Paul

From efaf8a3e8b5ef8f0810bb7202c3af6e50b7cb0f2 Mon Sep 17 00:00:00 2001 From: Paul Cochrane <paul@liekut.de> Date: Thu, 29 May 2014 16:07:47 +0200 Subject: [PATCH 1/2] Testing when regep matches are args to _CLASS This change exercises the use case mentioned in RT#87649. --- t/02_main.t | 14 +++++++++++++- t/12_main.t | 13 ++++++++++++- 2 files changed, 25 insertions(+), 2 deletions(-) diff --git a/t/02_main.t b/t/02_main.t index 64ef1e4..6ed6ce2 100644 --- a/t/02_main.t +++ b/t/02_main.t @@ -7,7 +7,7 @@ BEGIN { $ENV{PERL_PARAMS_UTIL_PP} ||= 0; } -use Test::More tests => 632; +use Test::More tests => 634; use File::Spec::Functions ':ALL'; use Scalar::Util 'refaddr'; use Params::Util (); @@ -142,6 +142,12 @@ foreach my $ident ( qw{foo _foo foo1 __foo_1 Foo::Bar _Foo::Baaar::Baz X::1} ) { is( Params::Util::_CLASS($ident), $ident, "...::_CLASS('$ident') returns ok" ); } +{ + my $class_name = "A::B"; + $class_name =~ /(.*)/; + is( Params::Util::_CLASS($1), $1, "...::_CLASS('$1') returns ok" ); +} + # Import the function use_ok( 'Params::Util', '_CLASS' ); ok( defined *_CLASS{CODE}, '_CLASS imported ok' ); @@ -166,6 +172,12 @@ foreach my $ident ( qw{foo _foo foo1 __foo_1 Foo::Bar _Foo::Baaar::Baz X::1} ) { is( _CLASS($ident), $ident, "_CLASS('$ident') returns ok" ); } +{ + my $class_name = "A::B"; + $class_name =~ /(.*)/; + is( _CLASS($1), $1, "_CLASS('$1') returns ok" ); +} + diff --git a/t/12_main.t b/t/12_main.t index d8cf68f..9a2301b 100644 --- a/t/12_main.t +++ b/t/12_main.t @@ -7,7 +7,7 @@ BEGIN { $ENV{PERL_PARAMS_UTIL_PP} ||= 1; } -use Test::More tests => 632; +use Test::More tests => 634; use File::Spec::Functions ':ALL'; use Scalar::Util 'refaddr'; use Params::Util (); @@ -142,6 +142,12 @@ foreach my $ident ( qw{foo _foo foo1 __foo_1 Foo::Bar _Foo::Baaar::Baz X::1} ) { is( Params::Util::_CLASS($ident), $ident, "...::_CLASS('$ident') returns ok" ); } +{ + my $class_name = "A::B"; + $class_name =~ /(.*)/; + is( Params::Util::_CLASS($1), $1, "...::_CLASS('$1') returns ok" ); +} + # Import the function use_ok( 'Params::Util', '_CLASS' ); ok( defined *_CLASS{CODE}, '_CLASS imported ok' ); @@ -166,6 +172,11 @@ foreach my $ident ( qw{foo _foo foo1 __foo_1 Foo::Bar _Foo::Baaar::Baz X::1} ) { is( _CLASS($ident), $ident, "_CLASS('$ident') returns ok" ); } +{ + my $class_name = "A::B"; + $class_name =~ /(.*)/; + is( _CLASS($1), $1, "_CLASS('$1') returns ok" ); +} -- 1.7.10.4

From fc5f43d3d173af3fc4335eec25854795d112aae4 Mon Sep 17 00:00:00 2001 From: Paul Cochrane <paul@liekut.de> Date: Thu, 29 May 2014 16:08:54 +0200 Subject: [PATCH 2/2] Accepting regexp matches as args to _CLASS This fixes the issue mentioned in RT#87649. --- lib/Params/Util.pm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/Params/Util.pm b/lib/Params/Util.pm index 9a40e59..fceffe1 100644 --- a/lib/Params/Util.pm +++ b/lib/Params/Util.pm @@ -189,7 +189,8 @@ C<undef> if not. eval <<'END_PERL' unless defined &_CLASS; sub _CLASS ($) { - (defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $_[0] : undef; + my $arg = $_[0]; + (defined $arg and ! ref $arg and $arg =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $arg : undef; } END_PERL -- 1.7.10.4