r2260 - in packages/libparams-check-perl/branches/upstream/current:
. lib/Params t
Krzysztof Krzyzaniak
eloy at costa.debian.org
Tue Mar 7 15:42:26 UTC 2006
Author: eloy
Date: 2006-03-07 15:42:26 +0000 (Tue, 07 Mar 2006)
New Revision: 2260
Modified:
packages/libparams-check-perl/branches/upstream/current/CHANGES
packages/libparams-check-perl/branches/upstream/current/META.yml
packages/libparams-check-perl/branches/upstream/current/lib/Params/Check.pm
packages/libparams-check-perl/branches/upstream/current/t/01_Params-Check.t
Log:
Load /tmp/tmp.KkJYvn/libparams-check-perl-0.24 into
packages/libparams-check-perl/branches/upstream/current.
Modified: packages/libparams-check-perl/branches/upstream/current/CHANGES
===================================================================
--- packages/libparams-check-perl/branches/upstream/current/CHANGES 2006-03-07 15:36:06 UTC (rev 2259)
+++ packages/libparams-check-perl/branches/upstream/current/CHANGES 2006-03-07 15:42:26 UTC (rev 2260)
@@ -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/branches/upstream/current/META.yml
===================================================================
--- packages/libparams-check-perl/branches/upstream/current/META.yml 2006-03-07 15:36:06 UTC (rev 2259)
+++ packages/libparams-check-perl/branches/upstream/current/META.yml 2006-03-07 15:42:26 UTC (rev 2260)
@@ -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/branches/upstream/current/lib/Params/Check.pm
===================================================================
--- packages/libparams-check-perl/branches/upstream/current/lib/Params/Check.pm 2006-03-07 15:36:06 UTC (rev 2259)
+++ packages/libparams-check-perl/branches/upstream/current/lib/Params/Check.pm 2006-03-07 15:42:26 UTC (rev 2260)
@@ -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/branches/upstream/current/t/01_Params-Check.t
===================================================================
--- packages/libparams-check-perl/branches/upstream/current/t/01_Params-Check.t 2006-03-07 15:36:06 UTC (rev 2259)
+++ packages/libparams-check-perl/branches/upstream/current/t/01_Params-Check.t 2006-03-07 15:42:26 UTC (rev 2260)
@@ -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 = {
More information about the Pkg-perl-cvs-commits
mailing list