[patch] Fwd: CPAN Upload: J/JP/JPEACOCK/version-0.64.tar.gz

Message-ID: <4488CB5C.4070702@rowman.com>

p4raw-id: //depot/perl@28375

diff --git a/lib/version.pm b/lib/version.pm
index 3fcb6b1..74313c3 100644 (file)
--- a/lib/version.pm
+++ b/lib/version.pm
@@ -6,8 +6,7 @@ use strict;
 
 use vars qw(@ISA $VERSION $CLASS *qv);
 
-$VERSION = "0.60_02";
-$VERSION = eval($VERSION);
+$VERSION = 0.64;
 
 $CLASS = 'version';
 
@@ -19,7 +18,7 @@ sub import {
     
     *{$callpkg."::qv"} = 
            sub {return bless version::qv(shift), $class }
-       unless $callpkg->can('qv');
+       unless defined (&{"$callpkg\::qv"});
 
 }
 

diff --git a/lib/version.pod b/lib/version.pod
index a874203..0f4f20d 100644 (file)
--- a/lib/version.pod
+++ b/lib/version.pod
@@ -261,6 +261,19 @@ must be quoted to be converted properly.  For this reason, it is strongly
 recommended that all initializers to qv() be quoted strings instead of
 bare numbers.
 
+To prevent the C<qv()> function from being exported to the caller's namespace,
+either use version with a null parameter:
+
+  use version ();
+
+or just require version, like this:
+
+  require version;
+
+Both methods will prevent the import() method from firing and exporting the
+C<qv()> sub.  This is true of subclasses of version as well, see
+L<SUBCLASSING> for details.
+
 =back
 
 For the subsequent examples, the following three objects will be used:
@@ -570,14 +583,10 @@ derived class:
 See also L<version::AlphaBeta> on CPAN for an alternate representation of
 version strings.
 
-B<NOTE:> the L<qv> operator is not a class method and will not be inherited
-in the same way as the other methods.  L<qv> will always return an object of
-type L<version> and not an object in the derived class.  If you need to
-have L<qv> return an object in your derived class, add something like this:
-
-  *::qv = sub { return bless version::qv(shift), __PACKAGE__ };
-
-as seen in the test file F<t/02derived.t>.
+B<NOTE:> Although the L<qv> operator is not a true class method, but rather a
+function exported into the caller's namespace, a subclass of version will 
+inherit an import() function which will perform the correct magic on behalf
+of the subclass.
 
 =head1 EXPORT
 

diff --git a/lib/version.t b/lib/version.t
index 055531c..c9da642 100644 (file)
--- a/lib/version.t
+++ b/lib/version.t
@@ -414,6 +414,23 @@ SKIP:      {
        $version = $CLASS->new(" 1.7");
        ok($version->numify eq "1.700", "leading space ignored");
 
+       # RT 19517 - deal with undef and 'undef' initialization
+       ok($version ne 'undef', "Undef version comparison #1");
+       ok($version ne undef, "Undef version comparison #2");
+       $version = $CLASS->new('undef');
+       unlike($warning, qr/^Version string 'undef' contains invalid data/,
+           "Version string 'undef'");
+
+       $version = $CLASS->new(undef);
+       like($warning, qr/^Use of uninitialized value/,
+           "Version string 'undef'");
+       ok($version eq 'undef', "Undef version comparison #3");
+       ok($version eq undef, "Undef version comparison #4");
+       eval "\$version = \$CLASS->new()"; # no parameter at all
+       unlike($@, qr/^Bizarre copy of CODE/, "No initializer at all");
+       ok($version eq 'undef', "Undef version comparison #5");
+       ok($version eq undef, "Undef version comparison #6");
+
 SKIP:  {
 
            # dummy up a legal module for testing RT#19017
@@ -443,6 +460,21 @@ EOF
 
            unlink 'www.pm';
        }
+ 
+       open F, ">vvv.pm" or die "Cannot open vvv.pm: $!\n";
+       print F <<"EOF";
+package vvv;
+use base qw(version);
+1;
+EOF
+       close F;
+       # need to eliminate any other qv()'s
+       undef *main::qv;
+       ok(!defined(&{"main\::qv"}), "make sure we cleared qv() properly");
+       eval "use lib '.'; use vvv;";
+       ok(defined(&{"main\::qv"}), "make sure we exported qv() properly");
+       isa_ok( qv(1.2), "vvv");
+       unlink 'vvv.pm';
 }
 
 1;

diff --git a/universal.c b/universal.c
index 705573e..a1e91b7 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -413,14 +413,10 @@ XS(XS_version_new)
                ? HvNAME(SvSTASH(SvRV(ST(0))))
                : (char *)SvPV_nolen(ST(0));
 
-       if ( items == 1 ) {
-           /* no parameter provided */
-           if ( sv_isobject(ST(0)) )
-           {
-               /* create empty object */
-               vs = sv_newmortal();
-               sv_setpvn(vs,"",0);
-           }
+       if ( items == 1 || vs == &PL_sv_undef ) { /* no param or explicit undef */
+           /* create empty object */
+           vs = sv_newmortal();
+           sv_setpvn(vs,"",0);
        }
        else if ( items == 3 ) {
            vs = sv_newmortal();

diff --git a/util.c b/util.c
index e4832de..07dd4d4 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4192,6 +4192,11 @@ Perl_scan_version(pTHX_ const char *s, SV *rv, bool qv)
     if ( av_len(av) == -1 ) /* oops, someone forgot to pass a value */
        av_push(av, newSViv(0));
 
+    /* fix RT#19517 - special case 'undef' as string */
+    if ( *s == 'u' && strEQ(s,"undef") ) {
+       s += 5;
+    }
+
     /* And finally, store the AV in the hash */
     hv_store((HV *)hv, "version", 7, newRV_noinc((SV *)av), 0);
     return s;
@@ -4311,12 +4316,13 @@ Perl_upg_version(pTHX_ SV *ver)
     {
        version = savepv(SvPV_nolen(ver));
     }
+
     s = scan_version(version, ver, qv);
     if ( *s != '\0' ) 
-        if(ckWARN(WARN_MISC))
+       if(ckWARN(WARN_MISC))
            Perl_warner(aTHX_ packWARN(WARN_MISC), 
-                "Version string '%s' contains invalid data; "
-               "ignoring: '%s'", version, s);
+               "Version string '%s' contains invalid data; "
+               "ignoring: '%s'", version, s);
     Safefree(version);
     return ver;
 }