Upgrade to version-0.53

p4raw-id: //depot/perl@26777

diff --git a/lib/version.pm b/lib/version.pm
index dafbae6..5af78ef 100644 (file)
--- a/lib/version.pm
+++ b/lib/version.pm
@@ -11,7 +11,7 @@ use vars qw(@ISA $VERSION $CLASS @EXPORT);
 
 @EXPORT = qw(qv);
 
-$VERSION = 0.52;
+$VERSION = 0.53;
 
 $CLASS = 'version';
 

diff --git a/lib/version.t b/lib/version.t
index 16f306c..9ed5d5b 100644 (file)
--- a/lib/version.t
+++ b/lib/version.t
@@ -98,12 +98,31 @@ sub BaseTests {
        like($@, qr/alpha without decimal/,
            "Invalid version format (alpha without decimal)");
 
-       $version = $CLASS->new("99 and 44/100 pure");
+       # for this first test, just upgrade the warn() to die()
+       eval {
+           local $SIG{__WARN__} = sub { die $_[0] };
+           $version = $CLASS->new("1.2b3");
+       };
+       my $warnregex = "Version string '.+' contains invalid data; ".
+               "ignoring: '.+'";
+
+       like($@, qr/$warnregex/,
+           "Version string contains invalid data; ignoring");
+
+       # from here on out capture the warning and test independently
+       my $warning;
+       local $SIG{__WARN__} = sub { $warning = $_[0] };
+       $version = $CLASS->new("99 and 44/100 pure");
+
+       like($warning, qr/$warnregex/,
+           "Version string contains invalid data; ignoring");
        ok ("$version" eq "99.000", '$version eq "99.000"');
        ok ($version->numify == 99.0, '$version->numify == 99.0');
        ok ($version->normal eq "v99.0.0", '$version->normal eq v99.0.0');
        
        $version = $CLASS->new("something");
+       like($warning, qr/$warnregex/,
+           "Version string contains invalid data; ignoring");
        ok (defined $version, 'defined $version');
        
        # reset the test object to something reasonable

diff --git a/util.c b/util.c
index c503dda..59c287f 100644 (file)
--- a/util.c
+++ b/util.c
@@ -4225,7 +4225,7 @@ Returns a pointer to the upgraded SV.
 SV *
 Perl_upg_version(pTHX_ SV *ver)
 {
-    char *version;
+    const char *version, *s;
     bool qv = 0;
 
     if ( SvNOK(ver) ) /* may get too much accuracy */ 
@@ -4245,7 +4245,10 @@ Perl_upg_version(pTHX_ SV *ver)
     {
        version = savepv(SvPV_nolen(ver));
     }
-    (void)scan_version(version, ver, qv);
+    s = scan_version(version, ver, qv);
+    if ( *s != '\0' )
+       Perl_warn(aTHX_ "Version string '%s' contains invalid data; "
+             "ignoring: '%s'", version, s);
     Safefree(version);
     return ver;
 }