From: Steve Peters <steve@fisharerojo.org>
Date: Wed, 11 Jan 2006 03:22:57 +0000 (+0000)
Subject: Upgrade to version-0.53
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cd57dc11b379d64c4f58020ac5a49cbd7893e35a;p=p5sagit%2Fp5-mst-13.2.git

Upgrade to version-0.53

p4raw-id: //depot/perl@26777
---

diff --git a/lib/version.pm b/lib/version.pm
index dafbae6..5af78ef 100644
--- 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
--- 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
--- 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;
 }