Upgrade to Params::Check 0.26

p4raw-id: //depot/perl@30437

diff --git a/lib/Params/Check.pm b/lib/Params/Check.pm
index 66781f6..7348cbc 100644 (file)
--- a/lib/Params/Check.pm
+++ b/lib/Params/Check.pm
@@ -12,13 +12,13 @@ BEGIN {
     use vars        qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $ALLOW_UNKNOWN
                         $STRICT_TYPE $STRIP_LEADING_DASHES $NO_DUPLICATES
                         $PRESERVE_CASE $ONLY_ALLOW_DEFINED $WARNINGS_FATAL
-                        $SANITY_CHECK_TEMPLATE $CALLER_DEPTH
+                        $SANITY_CHECK_TEMPLATE $CALLER_DEPTH $_ERROR_STRING
                     ];
 
     @ISA        =   qw[ Exporter ];
     @EXPORT_OK  =   qw[check allow last_error];
 
-    $VERSION                = '0.25';
+    $VERSION                = '0.26';
     $VERBOSE                = $^W ? 1 : 0;
     $NO_DUPLICATES          = 0;
     $STRIP_LEADING_DASHES   = 0;
@@ -335,8 +335,10 @@ sub check {
 
         ### check if we have an allow handler, to validate against ###
         ### allow() will report its own errors ###
-        if( exists $tmpl{'allow'} and
-            not allow($args{$key}, $tmpl{'allow'})
+        if( exists $tmpl{'allow'} and not do {
+                local $_ERROR_STRING;
+                allow( $args{$key}, $tmpl{'allow'} )
+            }         
         ) {
             ### stringify the value in the error report -- we don't want dumps
             ### of objects, but we do want to see *roughly* what we passed
@@ -550,7 +552,7 @@ It is exported upon request.
 
 =cut
 
-{   my $ErrorString = '';
+{   $_ERROR_STRING = '';
 
     sub _store_error {
         my($err, $verbose, $offset) = @_[0..2];
@@ -562,14 +564,14 @@ It is exported upon request.
 
         carp $err if $verbose;
 
-        $ErrorString .= $err . "\n";
+        $_ERROR_STRING .= $err . "\n";
     }
 
     sub _clear_error {
-        $ErrorString = '';
+        $_ERROR_STRING = '';
     }
 
-    sub last_error { $ErrorString }
+    sub last_error { $_ERROR_STRING }
 }
 
 1;

diff --git a/lib/Params/Check/t/01_Params-Check.t b/lib/Params/Check/t/01_Params-Check.t
index e868d13..06f3048 100644 (file)
--- a/lib/Params/Check/t/01_Params-Check.t
+++ b/lib/Params/Check/t/01_Params-Check.t
@@ -347,3 +347,25 @@ use constant TRUE   => sub { 1 };
     like( last_error, qr/for .*::inner by .*::outer$/,
                             "right caller with CALLER_DEPTH" );
 }
+
+### test: #23824: Bug concering the loss of the last_error 
+### message when checking recursively.
+{   ok( 1,                      "Test last_error() on recursive check() call" ); 
+    
+    ### allow sub to call
+    my $clear   = sub { check( {}, {} ) if shift; 1; };
+
+    ### recursively call check() or not?
+    for my $recurse ( 0, 1 ) {         
+  
+        check(  
+            { a => { defined => 1 },
+              b => { allow   => sub { $clear->( $recurse ) } },
+            },
+            { a => undef, b => undef }
+        );       
+    
+        ok( last_error(),       "   last_error() with recurse: $recurse" );
+    }
+}
+