r2263 - in packages/libparams-check-perl/trunk: . lib/Params t

[Krzysztof Krzyzaniak]

Author: eloy
Date: 2006-03-07 15:46:16 +0000 (Tue, 07 Mar 2006)
New Revision: 2263

Modified:
   packages/libparams-check-perl/trunk/CHANGES
   packages/libparams-check-perl/trunk/META.yml
   packages/libparams-check-perl/trunk/lib/Params/Check.pm
   packages/libparams-check-perl/trunk/t/01_Params-Check.t
Log:
eloy: new upstream version


Modified: packages/libparams-check-perl/trunk/CHANGES
===================================================================
--- packages/libparams-check-perl/trunk/CHANGES	2006-03-07 15:45:52 UTC (rev 2262)
+++ packages/libparams-check-perl/trunk/CHANGES	2006-03-07 15:46:16 UTC (rev 2263)
@@ -1,3 +1,9 @@
+Changes for 0.24    Thu Mar  2 13:04:27 2006
+============================================
+
+* Fix issue where allow() wouldn't shortcut
+    after the first successful match (#17364)
+
 Changes for 0.22    Thu Nov 11 11:11:33 2004
 ============================================
 

Modified: packages/libparams-check-perl/trunk/META.yml
===================================================================
--- packages/libparams-check-perl/trunk/META.yml	2006-03-07 15:45:52 UTC (rev 2262)
+++ packages/libparams-check-perl/trunk/META.yml	2006-03-07 15:46:16 UTC (rev 2263)
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Params-Check
-version:      0.23
+version:      0.24
 version_from: lib/Params/Check.pm
 installdirs:  site
 requires:
@@ -9,4 +9,4 @@
     Test::More:                    0
 
 distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+generated_by: ExtUtils::MakeMaker version 6.30

Modified: packages/libparams-check-perl/trunk/lib/Params/Check.pm
===================================================================
--- packages/libparams-check-perl/trunk/lib/Params/Check.pm	2006-03-07 15:45:52 UTC (rev 2262)
+++ packages/libparams-check-perl/trunk/lib/Params/Check.pm	2006-03-07 15:46:16 UTC (rev 2263)
@@ -18,7 +18,7 @@
     @ISA        =   qw[ Exporter ];
     @EXPORT_OK  =   qw[check allow last_error];
 
-    $VERSION                = '0.23';
+    $VERSION                = '0.24';
     $VERBOSE                = $^W ? 1 : 0;
     $NO_DUPLICATES          = 0;
     $STRIP_LEADING_DASHES   = 0;
@@ -432,7 +432,12 @@
 
         ### loop over the elements, see if one of them says the
         ### value is OK
-        return unless grep { allow( $_[0], $_ ) } @{$_[1]};
+        ### also, short-cicruit when possible
+        for ( @{$_[1]} ) {
+            return 1 if allow( $_[0], $_ );
+        }
+        
+        return;
 
     ### fall back to a simple, but safe 'eq' ###
     } else {

Modified: packages/libparams-check-perl/trunk/t/01_Params-Check.t
===================================================================
--- packages/libparams-check-perl/trunk/t/01_Params-Check.t	2006-03-07 15:45:52 UTC (rev 2262)
+++ packages/libparams-check-perl/trunk/t/01_Params-Check.t	2006-03-07 15:46:16 UTC (rev 2263)
@@ -16,23 +16,30 @@
 use constant TRUE   => sub { 1 };
 
 ### allow tests ###
-ok( allow( 42, qr/^\d+$/ ), "Allow based on regex" );
-ok( allow( $0, $0),         "   Allow based on string" );
-ok( allow( 42, [0,42] ),    "   Allow based on list" );
-ok( allow( 42, [50,sub{1}]),"   Allow based on list containing sub");
-ok( allow( 42, TRUE ),      "   Allow based on constant sub" );
-ok(!allow( $0, qr/^\d+$/ ), "Disallowing based on regex" );
-ok(!allow( 42, $0 ),        "   Disallowing based on string" );
-ok(!allow( 42, [0,$0] ),    "   Disallowing based on list" );
-ok(!allow( 42, [50,sub{0}]),"   Disallowing based on list containing sub");
-ok(!allow( 42, FALSE ),     "   Disallowing based on constant sub" );
+{   ok( allow( 42, qr/^\d+$/ ), "Allow based on regex" );
+    ok( allow( $0, $0),         "   Allow based on string" );
+    ok( allow( 42, [0,42] ),    "   Allow based on list" );
+    ok( allow( 42, [50,sub{1}]),"   Allow based on list containing sub");
+    ok( allow( 42, TRUE ),      "   Allow based on constant sub" );
+    ok(!allow( $0, qr/^\d+$/ ), "Disallowing based on regex" );
+    ok(!allow( 42, $0 ),        "   Disallowing based on string" );
+    ok(!allow( 42, [0,$0] ),    "   Disallowing based on list" );
+    ok(!allow( 42, [50,sub{0}]),"   Disallowing based on list containing sub");
+    ok(!allow( 42, FALSE ),     "   Disallowing based on constant sub" );
 
-### check if the subs for allow get what you expect ###
-for my $thing (1,'foo',[1]) {
-    allow( $thing, 
-       sub { is_deeply(+shift,$thing,  "Allow coderef gets proper args") } );
+    ### check that allow short circuits where required 
+    {   my $sub_called;
+        allow( 1, [ 1, sub { $sub_called++ } ] );
+        ok( !$sub_called,       "Allow short-circuits properly" );
+    }        
+
+    ### check if the subs for allow get what you expect ###
+    for my $thing (1,'foo',[1]) {
+        allow( $thing, 
+           sub { is_deeply(+shift,$thing,  "Allow coderef gets proper args") } 
+        );
+    }
 }
-
 ### default tests ###
 {   
     my $tmpl =  {