Fix native methods which accept string to accept the empty string

diff --git a/Changes b/Changes
index 6567cca..3c14772 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,6 +1,16 @@
 Also see Moose::Manual::Delta for more details of, and workarounds
 for, noteworthy changes.
 
+NEXT
+
+  [BUG FIXES]
+
+  * A number of native trait methods which expected strings as arguments did
+    not allow the empty string. This included Array->join, String->match,
+    String->replace, and String->substr. Reported by Whitney Jackson. RT
+    #61961. (Dave Rolsky)
+
+
 1.15 Tue, Oct 5, 2010
 
   [API CHANGES]

diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/join.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/join.pm
index 53d73b4..4e522f7 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor/Native/Array/join.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/join.pm
@@ -30,7 +30,7 @@ sub _inline_check_arguments {
 
     return $self->_inline_throw_error(
         q{'The argument passed to join must be a string'})
-        . ' unless Moose::Util::_STRINGLIKE( $_[0] );';
+        . ' unless Moose::Util::_STRINGLIKE0( $_[0] );';
 }
 
 sub _return_value {

diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/match.pm b/lib/Moose/Meta/Method/Accessor/Native/String/match.pm
index a7a4f9d..a264612 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor/Native/String/match.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/String/match.pm
@@ -31,7 +31,7 @@ sub _inline_check_arguments {
 
     return $self->_inline_throw_error(
         q{'The argument passed to match must be a string or regexp reference'}
-    ) . q{ unless Moose::Util::_STRINGLIKE( $_[0] ) || Params::Util::_REGEX( $_[0] );};
+    ) . q{ unless Moose::Util::_STRINGLIKE0( $_[0] ) || Params::Util::_REGEX( $_[0] );};
 }
 
 sub _return_value {

diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/replace.pm b/lib/Moose/Meta/Method/Accessor/Native/String/replace.pm
index 63e3441..bdfd68a 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor/Native/String/replace.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/String/replace.pm
@@ -33,10 +33,10 @@ sub _inline_check_arguments {
     return $self->_inline_throw_error(
         q{'The first argument passed to replace must be a string or regexp reference'}
         )
-        . q{ unless Moose::Util::_STRINGLIKE( $_[0] ) || Params::Util::_REGEX( $_[0] );}
+        . q{ unless Moose::Util::_STRINGLIKE0( $_[0] ) || Params::Util::_REGEX( $_[0] );}
         . $self->_inline_throw_error(
         q{'The second argument passed to replace must be a string or code reference'}
-        ) . q{ unless Moose::Util::_STRINGLIKE( $_[1] ) || Params::Util::_CODELIKE( $_[1] );};
+        ) . q{ unless Moose::Util::_STRINGLIKE0( $_[1] ) || Params::Util::_CODELIKE( $_[1] );};
 }
 
 sub _potential_value {

diff --git a/lib/Moose/Meta/Method/Accessor/Native/String/substr.pm b/lib/Moose/Meta/Method/Accessor/Native/String/substr.pm
index 3e2692d..ed203ec 100644 (file)
--- a/lib/Moose/Meta/Method/Accessor/Native/String/substr.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/String/substr.pm
@@ -98,7 +98,7 @@ sub _inline_check_arguments {
             .= "\n"
             . $self->_inline_throw_error(
             q{'The third argument passed to substr must be a string'})
-            . q{ unless Moose::Util::_STRINGLIKE($replacement);};
+            . q{ unless Moose::Util::_STRINGLIKE0($replacement);};
     }
 
     return $code;

diff --git a/lib/Moose/Util.pm b/lib/Moose/Util.pm
index 55ad20e..ac48606 100644 (file)
--- a/lib/Moose/Util.pm
+++ b/lib/Moose/Util.pm
@@ -9,6 +9,7 @@ use Sub::Exporter;
 use Scalar::Util 'blessed';
 use List::Util qw(first);
 use List::MoreUtils qw(any all);
+use overload ();
 use Class::MOP   0.60;
 
 our $VERSION   = '1.15';
@@ -289,8 +290,10 @@ sub meta_class_alias {
 }
 
 # XXX - this should be added to Params::Util
-sub _STRINGLIKE ($) {
+sub _STRINGLIKE0 ($) {
     return _STRING( $_[0] )
+        || ( defined $_[0]
+        && $_[0] eq q{} )
         || ( blessed $_[0]
         && overload::Method( $_[0], q{""} )
         && length "$_[0]" );

diff --git a/t/070_native_traits/010_trait_array.t b/t/070_native_traits/010_trait_array.t
index 33cd4e5..ad61bd1 100644 (file)
--- a/t/070_native_traits/010_trait_array.t
+++ b/t/070_native_traits/010_trait_array.t
@@ -565,6 +565,11 @@ sub run_tests {
             'join returns expected result'
         );
 
+        is(
+            $obj->join(q{}), '1234',
+            'join returns expected result when joining with empty string'
+        );
+
         throws_ok { $obj->join }
         qr/Cannot call join without at least 1 argument/,
             'throws an error when passing no arguments to join';

diff --git a/t/070_native_traits/070_trait_string.t b/t/070_native_traits/070_trait_string.t
index d3029b7..5f6c028 100644 (file)
--- a/t/070_native_traits/070_trait_string.t
+++ b/t/070_native_traits/070_trait_string.t
@@ -157,6 +157,17 @@ sub run_tests {
             'substitution using string as replacement'
         );
 
+        $obj->_string('foo');
+        $obj->replace( qr/oo/, q{} );
+
+        is( $obj->_string, 'f',
+            'replace accepts an empty string as second argument' );
+
+        $obj->replace( q{}, 'a' );
+
+        is( $obj->_string, 'af',
+            'replace accepts an empty string as first argument' );
+
         throws_ok { $obj->replace( {}, 'x' ) }
         qr/The first argument passed to replace must be a string or regexp reference/,
             'replace throws an error when the first argument is not a string or regexp';
@@ -176,11 +187,21 @@ sub run_tests {
             'match -barx against /[aq]/ returns matches'
         );
 
+        is_deeply(
+            [ $obj->match(qr/([az]).*([fy])/) ], [ 'a', 'f' ],
+            'match -barx against /[aq]/ returns matches'
+        );
+
         ok(
             scalar $obj->match('b'),
             'match with string as argument returns true'
         );
 
+        ok(
+            scalar $obj->match(q{}),
+            'match with empty string as argument returns true'
+        );
+
         throws_ok { $obj->match }
         qr/Cannot call match without at least 1 argument/,
             'match throws an error when no arguments are passed';
@@ -221,6 +242,13 @@ sub run_tests {
             'substr as setter with three arguments'
         );
 
+        $obj->substr( 1, 3, '' );
+
+        is(
+            $obj->_string, 's long string',
+            'substr as setter with three arguments, replacment is empty string'
+        );
+
         throws_ok { $obj->substr }
         qr/Cannot call substr without at least 1 argument/,
             'substr throws an error when no argumemts are passed';