Hello community,
here is the log from the commit of package perl-Params-Validate
checked in at Fri Sep 29 18:15:15 CEST 2006.
--------
--- perl-Params-Validate/perl-Params-Validate.changes 2006-01-25 21:39:54.000000000 +0100
+++ /mounts/work_src_done/STABLE/perl-Params-Validate/perl-Params-Validate.changes 2006-09-29 14:15:11.000000000 +0200
@@ -1,0 +2,9 @@
+Fri Sep 29 14:09:21 CEST 2006 - anicka@suse.cz
+
+- update to 0.84
+ * XS version uses Carp::confess instead of Carp::croak
+ * bugfixes
+ * speed optimalizations
+- remove last patch (fixed in upstream)
+
+-------------------------------------------------------------------
Old:
----
Params-Validate-0.79.tar.bz2
Params-Validate-codecleanup.diff
New:
----
Params-Validate-0.84.tar.bz2
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Params-Validate.spec ++++++
--- /var/tmp/diff_new_pack.8PkRXe/_old 2006-09-29 18:13:57.000000000 +0200
+++ /var/tmp/diff_new_pack.8PkRXe/_new 2006-09-29 18:13:57.000000000 +0200
@@ -1,25 +1,25 @@
#
-# spec file for package perl-Params-Validate (Version 0.79)
+# spec file for package perl-Params-Validate (Version 0.84)
#
# Copyright (c) 2006 SUSE LINUX Products GmbH, Nuernberg, Germany.
# This file and all modifications and additions to the pristine
# package are under the same license as the package itself.
#
-# Please submit bugfixes or comments via http://bugs.opensuse.org
+# Please submit bugfixes or comments via http://bugs.opensuse.org/
#
# norootforbuild
Name: perl-Params-Validate
+URL: http://cpan.org/modules/by-module/Params/
License: GPL
Group: Development/Libraries/Perl
Requires: perl = %{perl_version}
#Conflicts: perlmod
Autoreqprov: on
-Version: 0.79
+Version: 0.84
Release: 1
Source: Params-Validate-%{version}.tar.bz2
-Patch: Params-Validate-codecleanup.diff
Summary: provides a system for validation method/function call parameters
BuildRoot: %{_tmppath}/%{name}-%{version}-build
@@ -39,7 +39,6 @@
%prep
%setup -q -n Params-Validate-%{version}
-%patch
%build
perl Makefile.PL
@@ -67,6 +66,12 @@
%{_mandir}/man3/*.3pm.gz
%changelog -n perl-Params-Validate
+* Fri Sep 29 2006 - anicka@suse.cz
+- update to 0.84
+ * XS version uses Carp::confess instead of Carp::croak
+ * bugfixes
+ * speed optimalizations
+- remove last patch (fixed in upstream)
* Wed Jan 25 2006 - mls@suse.de
- converted neededforbuild to BuildRequires
* Mon Jan 16 2006 - sf@suse.de
++++++ Params-Validate-0.79.tar.bz2 -> Params-Validate-0.84.tar.bz2 ++++++
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/Changes new/Params-Validate-0.84/Changes
--- old/Params-Validate-0.79/Changes 2006-01-13 18:45:31.000000000 +0100
+++ new/Params-Validate-0.84/Changes 2006-05-29 17:11:59.000000000 +0200
@@ -1,3 +1,55 @@
+0.84 May29, 2006
+
+- The XS version of the code used Carp::croak to report failures,
+while the Perl version used Carp::confess. The module has always been
+documented as using confess, so now the XS version uses this.
+
+- The new compiler detection code always returned false if you didn't
+have ExtUtils::CBuilder installed.
+
+
+0.83 May 28, 2006
+
+- Change how C compiler detection is done in the Makefile.PL so it
+does not rely on having make on the system. The new way should work on
+(most?) Unix and Win32 systems. Suggested by David Golden. See RT
+18969 (for DateTime.pm, but equally applicable to this module). Will
+hopefully fix RT 17644.
+
+- Previously, if a parameter was undefined, regex checks for that
+parameter always failed. However, it's quite possible for a regex to
+successfully match an undefined value (qr/^$/, for example). Now the
+code treats undef as an empty string ('') in regex checks. Reported by
+Duncan Salada.
+
+
+0.82 May 9, 2006
+
+- Disabled function inlining if _MSC_VER is defined. Patch from Audrey
+Tang.
+
+- Check isa by calling it as a method on the thing being checked.
+
+- Do the same for can in the pure Perl version. This was already fixed
+for the XS version in 0.75.
+
+
+0.81 Apr 1, 2006
+
+- Speed up no validation in XS version by short-circuiting immediately
+if validation is off. This gives a noticeable speed boost when
+$ENV{NO_VALIDATION} is in use. Patch by Daisuke Maki.
+
+- Inlined some C functions for additional speed in the XS
+version. Patch by Daisuke Maki.
+
+
+0.80 Jan 22, 2006
+
+- If a undef value was given for a parameter that had a regex in its
+spec, a warning was emitted. RT #15196.
+
+
0.79 Jan 13, 2006
- The XS version of Params::Validate did not work if a spec hash
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/MANIFEST new/Params-Validate-0.84/MANIFEST
--- old/Params-Validate-0.79/MANIFEST 2006-01-13 18:46:49.000000000 +0100
+++ new/Params-Validate-0.84/MANIFEST 2006-05-10 00:03:12.000000000 +0200
@@ -32,6 +32,8 @@
t/22-overload-can-bug.t
t/23-readonly.t
t/24-tied.t
+t/25-undef-regex.t
+t/26-isa.t
t/callbacks.pl
t/defaults.pl
t/regex.pl
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/META.yml new/Params-Validate-0.84/META.yml
--- old/Params-Validate-0.79/META.yml 2006-01-13 18:49:08.000000000 +0100
+++ new/Params-Validate-0.84/META.yml 2006-05-29 17:12:44.000000000 +0200
@@ -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-Validate
-version: 0.79
+version: 0.84
version_from: lib/Params/Validate.pm
installdirs: site
requires:
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/Makefile.PL new/Params-Validate-0.84/Makefile.PL
--- old/Params-Validate-0.79/Makefile.PL 2005-12-18 20:14:34.000000000 +0100
+++ new/Params-Validate-0.84/Makefile.PL 2006-05-29 17:11:35.000000000 +0200
@@ -12,7 +12,7 @@
for (@ARGV)
{
/^--pm/ and $no_xs = 1;
- /^--xs/ and $force_xs = 1;
+ /^--xs/ and $no_xs = 0;
}
if ($no_xs)
@@ -21,56 +21,39 @@
exit;
}
-my @clean;
-unless ($force_xs)
+unless (defined $no_xs)
{
- print "Testing if you have a C compiler\n";
+ check_for_compiler()
+ or no_cc();
- unless ( open F, ">test.c" )
+ if ( -d '.svn' )
{
- warn "Cannot write test.c, skipping test compilation and install pure Perl version.\n";
- no_cc();
- }
-
- print F <<'EOF';
-int main() { return 0; }
-EOF
+ local *DIR;
+ opendir DIR, "t" or die "Cannot read t: $!";
- close F or no_cc();
+ foreach my $file ( grep { /^\d.+\.t$/ } readdir DIR )
+ {
+ next if $file eq '99-pod.t';
- system("$Config{make} test$Config{obj_ext}") and no_cc();
-
-}
-
-if ( -d '.svn' )
-{
- local *DIR;
- opendir DIR, "t" or die "Cannot read t: $!";
-
- foreach my $file ( grep { /^\d.+\.t$/ } readdir DIR )
- {
- next if $file eq '99-pod.t';
+ my $real_file = File::Spec->catfile( 't', $file );
- my $real_file = File::Spec->catfile( 't', $file );
+ local *F;
+ open F, "<$real_file" or die "Cannot read $real_file: $!";
- local *F;
- open F, "<$real_file" or die "Cannot read $real_file: $!";
+ my $shbang = <F>;
+ my $test = do { local $/; <F> };
- my $shbang = <F>;
- my $test = do { local $/; <F> };
+ close F;
- close F;
+ $test = "$shbang\nBEGIN { \$ENV{PV_TEST_PERL} = 1 }\n\n$test";
- $test = "$shbang\nBEGIN { \$ENV{PV_TEST_PERL} = 1 }\n\n$test";
+ my $new_file = File::Spec->catfile( 't', "zz_$file" );
+ open F, ">$new_file" or die "Cannot write $new_file: $!";
- my $new_file = File::Spec->catfile( 't', "zz_$file" );
- open F, ">$new_file" or die "Cannot write $new_file: $!";
+ print F $test;
- print F $test;
-
- close F;
-
- push @clean, $new_file;
+ close F;
+ }
}
}
@@ -78,25 +61,16 @@
sub write_makefile
{
- print <<'EOF';
-
-*** NOTE ***
-
-You can safely ignore the warnings below about 'Too late to run
-CHECK/INIT blocks'.
-
-*************
-
-EOF
-
my %prereq = ( 'Test::More' => 0 );
$prereq{'Attribute::Handlers'} = 0 if $] >= 5.006;
+ my $zz = join ' ', glob File::Spec->catfile( 't', 'zz_*.t' );
+
WriteMakefile( VERSION_FROM => "lib/Params/Validate.pm",
NAME => "Params::Validate",
PREREQ_PM => \%prereq,
CONFIGURE => \&init,
- clean => { FILES => "test.c test.o @clean" },
+ clean => { FILES => "test.c test.o $zz" },
( $] >= 5.005 ?
( ABSTRACT_FROM => 'lib/Params/Validate.pm',
AUTHOR => 'Dave Rolsky, ') :
@@ -134,3 +108,44 @@
write_makefile();
exit;
}
+
+sub check_for_compiler
+{
+ print "Testing if you have a C compiler\n";
+
+ eval { require ExtUtils::CBuilder };
+ if ($@)
+ {
+ return _check_for_compiler_manually();
+ }
+ else
+ {
+ return _check_for_compiler_with_cbuilder();
+ }
+}
+
+sub _check_for_compiler_with_cbuilder
+{
+ my $cb = ExtUtils::CBuilder->new( quiet => 1 );
+
+ return $cb->have_compiler;
+}
+
+sub _check_for_compiler_manually
+{
+ unless ( open F, ">test.c" )
+ {
+ warn "Cannot write test.c, skipping test compilation and installing pure Perl version.\n";
+ return 0;
+ }
+
+ print F <<'EOF';
+int main() { return 0; }
+EOF
+
+ close F or return 0;
+
+ system( "$Config{cc} -o test$Config{obj_ext} test.c" ) and return 0;
+
+ return 1;
+}
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/Validate.xs new/Params-Validate-0.84/Validate.xs
--- old/Params-Validate-0.79/Validate.xs 2006-01-13 18:42:32.000000000 +0100
+++ new/Params-Validate-0.84/Validate.xs 2006-05-29 07:36:59.000000000 +0200
@@ -10,6 +10,12 @@
#define NEED_newCONSTSUB
#include "ppport.h"
+#ifdef _MSC_VER
+#define INLINE
+#else
+#define INLINE inline
+#endif
+
/* not defined in 5.00503 _or_ ppport.h! */
#ifndef CopSTASHPV
# ifdef USE_ITHREADS
@@ -112,7 +118,6 @@
static void
bootinit()
{
- char* str;
HV* stash;
/* define constants */
@@ -131,20 +136,20 @@
newCONSTSUB(stash, "BOOLEAN", newSViv(BOOLEAN));
}
-static bool
+INLINE static bool
no_validation()
{
SV* no_v;
no_v = perl_get_sv("Params::Validate::NO_VALIDATION", 0);
if (! no_v)
- croak("Cannot retrieve $Params::Validate::NO_VALIATION\n");
+ croak("Cannot retrieve $Params::Validate::NO_VALIDATION\n");
return SvTRUE(no_v);
}
/* return type string that corresponds to typemask */
-static SV*
+INLINE static SV*
typemask_to_string(IV mask)
{
SV* buffer;
@@ -197,7 +202,7 @@
}
/* compute numberic datatype for variable */
-static IV
+INLINE static IV
get_type(SV* sv)
{
IV type = 0;
@@ -242,6 +247,7 @@
}
/* get an article for given string */
+INLINE
#if (PERL_VERSION >= 6) /* Perl 5.6.0+ */
static const char*
#else
@@ -313,7 +319,7 @@
PUSHMARK(SP);
XPUSHs(message);
PUTBACK;
- perl_call_pv("Carp::croak", G_DISCARD);
+ perl_call_pv("Carp::confess", G_DISCARD);
}
return;
@@ -364,23 +370,63 @@
validate_isa(SV* value, SV* package, SV* id, HV* options)
{
SV* buffer;
+ IV ok = 1;
- /* quick test directly from Perl internals */
- if (sv_derived_from(value, SvPV_nolen(package))) return 1;
+ if (SvOK(value)) {
+ dSP;
- buffer = sv_2mortal(newSVsv(id));
- sv_catpv(buffer, " to ");
- sv_catsv(buffer, get_called(options));
- sv_catpv(buffer, " was not ");
- sv_catpv(buffer, article(package));
- sv_catpv(buffer, " '");
- sv_catsv(buffer, package);
- sv_catpv(buffer, "' (it is ");
- sv_catpv(buffer, article(value));
- sv_catpv(buffer, " ");
- sv_catsv(buffer, value);
- sv_catpv(buffer, ")\n");
- FAIL(buffer, options);
+ SV* ret;
+ IV count;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ EXTEND(SP, 2);
+ PUSHs(value);
+ PUSHs(package);
+ PUTBACK;
+
+ count = call_method("isa", G_SCALAR);
+
+ if (! count)
+ croak("Calling can did not return a value");
+
+ SPAGAIN;
+
+ ret = POPs;
+ SvGETMAGIC(ret);
+
+ ok = SvTRUE(ret);
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ } else {
+ ok = 0;
+ }
+
+ if (! ok) {
+ buffer = sv_2mortal(newSVsv(id));
+ sv_catpv(buffer, " to ");
+ sv_catsv(buffer, get_called(options));
+ sv_catpv(buffer, " was not ");
+ sv_catpv(buffer, article(package));
+ sv_catpv(buffer, " '");
+ sv_catsv(buffer, package);
+ sv_catpv(buffer, "' (it is ");
+ if ( SvOK(value) ) {
+ sv_catpv(buffer, article(value));
+ sv_catpv(buffer, " ");
+ sv_catsv(buffer, value);
+ } else {
+ sv_catpv(buffer, "undef");
+ }
+ sv_catpv(buffer, ")\n");
+ FAIL(buffer, options);
+ }
+
+ return 1;
}
static IV
@@ -954,6 +1000,68 @@
}
}
+void
+apply_defaults(HV *ret, HV *p, HV *specs, AV *missing)
+{
+ HE* he;
+ SV** temp;
+
+ hv_iterinit(specs);
+ while (he = hv_iternext(specs)) {
+ HV* spec;
+ SV* val;
+
+ val = HeVAL(he);
+
+ /* get extended param spec if available */
+ if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) {
+ spec = (HV*) SvRV(val);
+ } else {
+ spec = NULL;
+ }
+
+ /* test for parameter existence */
+ if (hv_exists_ent(p, HeSVKEY_force(he), HeHASH(he))) {
+ continue;
+ }
+
+ /* parameter may not be defined but we may have default */
+ if (spec && (temp = hv_fetch(spec, "default", 7, 0))) {
+ SV* value;
+
+ SvGETMAGIC(*temp);
+ value = sv_2mortal(newSVsv(*temp));
+
+ /* make sure that parameter is put into return hash */
+ if (GIMME_V != G_VOID) {
+ if (!hv_store_ent(ret, HeSVKEY_force(he),
+ SvREFCNT_inc(value), HeHASH(he))) {
+ SvREFCNT_dec(value);
+ croak("Cannot add new key to hash");
+ }
+ }
+
+ continue;
+ }
+
+ /* find if missing parameter is mandatory */
+ if (! no_validation()) {
+ SV** temp;
+
+ if (spec) {
+ if (temp = hv_fetch(spec, "optional", 8, 0)) {
+ SvGETMAGIC(*temp);
+
+ if (SvTRUE(*temp)) continue;
+ }
+ } else if (!SvTRUE(HeVAL(he))) {
+ continue;
+ }
+ av_push(missing, SvREFCNT_inc(HeSVKEY_force(he)));
+ }
+ }
+}
+
static IV
validate(HV* p, HV* specs, HV* options, HV* ret)
{
@@ -998,6 +1106,30 @@
specs = normalize_hash_keys(specs, normalize_func, strip_leading, ignore_case);
}
+ /* short-circuit everything else when no_validation is true */
+ if (no_validation()) {
+ if (GIMME_V != G_VOID) {
+ while (he = hv_iternext(p)) {
+ /* This may be related to bug #7387 on bugs.perl.org */
+#if (PERL_VERSION == 5)
+ if (! PL_tainting)
+#endif
+ SvGETMAGIC(HeVAL(he));
+
+
+ /* put the parameter into return hash */
+ if (!hv_store_ent(ret, HeSVKEY_force(he), SvREFCNT_inc(HeVAL(he)),
+ HeHASH(he))) {
+ SvREFCNT_dec(HeVAL(he));
+ croak("Cannot add new key to hash");
+ }
+ }
+ apply_defaults(ret, p, specs, NULL);
+ }
+
+ return 1;
+ }
+
if (temp = hv_fetch(options, "allow_extra", 11, 0)) {
SvGETMAGIC(*temp);
allow_extra = SvTRUE(*temp);
@@ -1006,8 +1138,7 @@
}
/* find extra parameters and validate good parameters */
- if (! no_validation())
- unmentioned = (AV*) sv_2mortal((SV*) newAV());
+ unmentioned = (AV*) sv_2mortal((SV*) newAV());
hv_iterinit(p);
while (he = hv_iternext(p)) {
@@ -1017,7 +1148,6 @@
#endif
SvGETMAGIC(HeVAL(he));
-
/* put the parameter into return hash */
if (GIMME_V != G_VOID) {
if (!hv_store_ent(ret, HeSVKEY_force(he), SvREFCNT_inc(HeVAL(he)),
@@ -1027,7 +1157,6 @@
}
}
- if (!no_validation()) {
/* check if this parameter is defined in spec and if it is
then validate it using spec */
he1 = hv_fetch_ent(specs, HeSVKEY_force(he), 0, HeHASH(he));
@@ -1057,9 +1186,8 @@
} else if (! allow_extra) {
av_push(unmentioned, SvREFCNT_inc(HeSVKEY_force(he)));
}
- }
- if (!no_validation() && av_len(unmentioned) > -1) {
+ if (av_len(unmentioned) > -1) {
SV* buffer;
buffer = sv_2mortal(newSVpv("The following parameter", 0));
@@ -1092,65 +1220,11 @@
validate_named_depends(p, specs, options);
/* find missing parameters */
- if (! no_validation())
- missing = (AV*) sv_2mortal((SV*) newAV());
-
- hv_iterinit(specs);
- while (he = hv_iternext(specs)) {
- HV* spec;
- SV* val;
-
- val = HeVAL(he);
+ missing = (AV*) sv_2mortal((SV*) newAV());
- /* get extended param spec if available */
- if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) {
- spec = (HV*) SvRV(val);
- } else {
- spec = NULL;
- }
-
- /* test for parameter existence */
- if (hv_exists_ent(p, HeSVKEY_force(he), HeHASH(he))) {
- continue;
- }
+ apply_defaults(ret, p, specs, missing);
- /* parameter may not be defined but we may have default */
- if (spec && (temp = hv_fetch(spec, "default", 7, 0))) {
- SV* value;
-
- SvGETMAGIC(*temp);
- value = sv_2mortal(newSVsv(*temp));
-
- /* make sure that parameter is put into return hash */
- if (GIMME_V != G_VOID) {
- if (!hv_store_ent(ret, HeSVKEY_force(he),
- SvREFCNT_inc(value), HeHASH(he))) {
- SvREFCNT_dec(value);
- croak("Cannot add new key to hash");
- }
- }
-
- continue;
- }
-
- /* find if missing parameter is mandatory */
- if (! no_validation()) {
- SV** temp;
-
- if (spec) {
- if (temp = hv_fetch(spec, "optional", 8, 0)) {
- SvGETMAGIC(*temp);
-
- if (SvTRUE(*temp)) continue;
- }
- } else if (!SvTRUE(HeVAL(he))) {
- continue;
- }
- av_push(missing, SvREFCNT_inc(HeSVKEY_force(he)));
- }
- }
-
- if (! no_validation() && av_len(missing) > -1) {
+ if (av_len(missing) > -1) {
SV* buffer;
buffer = sv_2mortal(newSVpv("Mandatory parameter", 0));
@@ -1260,6 +1334,34 @@
IV min = -1;
AV* untaint_indexes = (AV*) sv_2mortal((SV*) newAV());
+ if (no_validation()) {
+ IV spec_count = av_len(specs);
+ IV p_count = av_len(p);
+ IV max = spec_count > p_count ? spec_count : p_count;
+
+ if (GIMME_V == G_VOID)
+ return 1;
+
+ for (i = 0; i <= max; i++) {
+ if (i <= spec_count) {
+ spec = *av_fetch(specs, i, 1);
+ SvGETMAGIC(spec);
+ complex_spec = (SvROK(spec) && SvTYPE(SvRV(spec)) == SVt_PVHV);
+ }
+
+ if (i <= av_len(p)) {
+ value = *av_fetch(p, i, 1);
+ SvGETMAGIC(value);
+ av_push(ret, SvREFCNT_inc(value));
+ } else if (complex_spec &&
+ (temp = hv_fetch((HV*) SvRV(spec), "default", 7, 0))) {
+ SvGETMAGIC(*temp);
+ av_push(ret, SvREFCNT_inc(*temp));
+ }
+ }
+ return 1;
+ }
+
/* iterate through all parameters and validate them */
for (i = 0; i <= av_len(specs); i++) {
spec = *av_fetch(specs, i, 1);
@@ -1277,7 +1379,7 @@
value = *av_fetch(p, i, 1);
SvGETMAGIC(value);
- if (! no_validation() && complex_spec) {
+ if (complex_spec) {
IV untaint = 0;
buffer = sv_2mortal(newSVpvf("Parameter #%d (", (int) i + 1));
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/lib/Params/Validate.pm new/Params-Validate-0.84/lib/Params/Validate.pm
--- old/Params-Validate-0.79/lib/Params/Validate.pm 2006-01-13 18:45:37.000000000 +0100
+++ new/Params-Validate-0.84/lib/Params/Validate.pm 2006-05-29 17:11:50.000000000 +0200
@@ -16,7 +16,7 @@
@ISA = 'Exporter';
- $VERSION = '0.79';
+ $VERSION = '0.84';
my %tags =
( types =>
@@ -350,6 +350,10 @@
The value of the "regex" key may be either a string or a pre-compiled
regex created via C<qr>.
+If the value being checked against a regex is undefined, the regex is
+explicitly checked against the empty string ('') instead, in order to
+avoid "Use of uninitialized value" warnings.
+
The CRegexp::Common module on CPAN is an excellent source of regular
expressions suitable for validating input.
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/lib/Params/ValidatePP.pm new/Params-Validate-0.84/lib/Params/ValidatePP.pm
--- old/Params-Validate-0.79/lib/Params/ValidatePP.pm 2005-12-18 20:14:34.000000000 +0100
+++ new/Params-Validate-0.84/lib/Params/ValidatePP.pm 2006-05-28 18:25:16.000000000 +0200
@@ -478,7 +478,7 @@
{
foreach ( ref $spec->{isa} ? @{ $spec->{isa} } : $spec->{isa} )
{
- unless ( UNIVERSAL::isa( $value, $_ ) )
+ unless ( eval { $value->isa($_) } )
{
my $is = ref $value ? ref $value : 'plain scalar';
my $article1 = $_ =~ /^[aeiou]/i ? 'an' : 'a';
@@ -497,7 +497,7 @@
{
foreach ( ref $spec->{can} ? @{ $spec->{can} } : $spec->{can} )
{
- unless ( defined $value && $value->can($_) )
+ unless ( eval { $value->can($_) } )
{
my $called = _get_called(1);
@@ -537,7 +537,7 @@
if ( exists $spec->{regex} )
{
- unless ( $value =~ /$spec->{regex}/ )
+ unless ( ( defined $value ? $value : '' ) =~ /$spec->{regex}/ )
{
my $called = _get_called(1);
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/lib/Params/ValidateXS.pm new/Params-Validate-0.84/lib/Params/ValidateXS.pm
--- old/Params-Validate-0.79/lib/Params/ValidateXS.pm 2005-12-18 20:14:34.000000000 +0100
+++ new/Params-Validate-0.84/lib/Params/ValidateXS.pm 2006-05-28 18:23:27.000000000 +0200
@@ -49,7 +49,7 @@
}
}
-sub _check_regex_from_xs { return $_[0] =~ /$_[1]/ ? 1 : 0 }
+sub _check_regex_from_xs { return ( defined $_[0] ? $_[0] : '' ) =~ /$_[1]/ ? 1 : 0 }
BEGIN
{
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/t/25-undef-regex.t new/Params-Validate-0.84/t/25-undef-regex.t
--- old/Params-Validate-0.79/t/25-undef-regex.t 1970-01-01 01:00:00.000000000 +0100
+++ new/Params-Validate-0.84/t/25-undef-regex.t 2006-01-23 05:52:36.000000000 +0100
@@ -0,0 +1,16 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Params::Validate qw(validate);
+use Test::More tests => 2;
+
+{
+ my @w;
+ local $SIG{__WARN__} = sub { push @w, @_ };
+
+ my @p = ( foo => undef);
+ eval { validate( @p, { foo => { regex => qr/^bar/ } } ) };
+ ok( $@, 'validation failed' );
+ ok( ! @w, 'no warnings' );
+}
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/t/26-isa.t new/Params-Validate-0.84/t/26-isa.t
--- old/Params-Validate-0.79/t/26-isa.t 1970-01-01 01:00:00.000000000 +0100
+++ new/Params-Validate-0.84/t/26-isa.t 2006-05-09 23:59:39.000000000 +0200
@@ -0,0 +1,120 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Params::Validate qw(validate);
+use Test::More tests => 9;
+
+{
+ my @p = ( foo => 'ClassISA' );
+
+ eval
+ {
+ validate( @p,
+ { foo => { isa => 'FooBar' } },
+ );
+ };
+
+ is( $@, '', 'no error checking if ClassISA->isa(FooBar)' );
+
+ eval
+ {
+ validate( @p,
+ { foo => { isa => 'Thingy' } },
+ );
+ };
+
+ like( $@, qr/was not a 'Thingy'/ );
+}
+
+{
+ my @p = ( foo => undef );
+ eval
+ {
+ validate( @p,
+ { foo => { isa => 'FooBar' } },
+ );
+ };
+
+ like( $@, qr/was not a 'FooBar'/ );
+}
+
+{
+ my @p = ( foo => 'SubClass' );
+
+ eval
+ {
+ validate( @p,
+ { foo => { isa => 'ClassISA' } },
+ );
+ };
+
+ ok( ! $@, 'SubClass->isa(ClassISA)' );
+
+ eval
+ {
+ validate( @p,
+ { foo => { isa => 'FooBar' } },
+ );
+ };
+
+ ok( ! $@, 'SubClass->isa(FooBar)' );
+
+ eval
+ {
+ validate( @p,
+ { foo => { isa => 'Thingy' } },
+ );
+ };
+
+ like( $@, qr/was not a 'Thingy'/ );
+}
+
+{
+ my @p = ( foo => bless {}, 'SubClass' );
+
+ eval
+ {
+ validate( @p,
+ { foo => { isa => 'ClassISA' } },
+ );
+ };
+
+ ok( ! $@, 'SubClass->isa(ClassISA)' );
+
+ eval
+ {
+ validate( @p,
+ { foo => { isa => 'FooBar' } },
+ );
+ };
+
+ ok( ! $@, 'SubClass->isa(FooBar)' );
+
+ eval
+ {
+ validate( @p,
+ { foo => { isa => 'Thingy' } },
+ );
+ };
+
+ like( $@, qr/was not a 'Thingy'/ );
+}
+
+
+
+package ClassISA;
+
+sub isa
+{
+ return 1 if $_[1] eq 'FooBar';
+ return $_[0]->SUPER::isa($_[1]);
+}
+
+sub thingy { 1 }
+
+package SubClass;
+
+use base 'ClassISA';
+
+
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Params-Validate-0.79/t/regex.pl new/Params-Validate-0.84/t/regex.pl
--- old/Params-Validate-0.79/t/regex.pl 2005-12-18 20:14:33.000000000 +0100
+++ new/Params-Validate-0.84/t/regex.pl 2006-05-28 18:20:55.000000000 +0200
@@ -1,5 +1,5 @@
use Test;
-BEGIN { plan test => 6 }
+BEGIN { plan test => 7 }
my $r = '^bar$';
eval
@@ -51,6 +51,13 @@
};
ok( ! $@ );
+eval
+{
+ my @a = ( foo => undef );
+ validate( @a, { foo => { regex => qr/^$|^bubba$/ } } );
+};
+ok( ! $@ );
+
1;
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Remember to have fun...
---------------------------------------------------------------------
To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org
For additional commands, e-mail: opensuse-commit+help@opensuse.org