commit perl-Params-Validate

29 Sep 2006

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, <autarch@urth.org>') :
@@ -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 C<Regexp::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

    

root＠suse.de

tags

participants (1)