From: John Peacock Date: Tue, 13 Apr 2004 20:51:31 +0000 (-0400) Subject: 's to bring bleadperl up to version-0.39 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=13f8f3987335c6eed94bd796ae4e7be8f788fdbf;p=p5sagit%2Fp5-mst-13.2.git 's to bring bleadperl up to version-0.39 Message-ID: <407C8B13.9020104@rowman.com> p4raw-id: //depot/perl@22692 --- diff --git a/lib/version.pm b/lib/version.pm index 232e2f2..5d1b4f2 100644 --- a/lib/version.pm +++ b/lib/version.pm @@ -12,7 +12,7 @@ use vars qw(@ISA $VERSION $CLASS @EXPORT); @EXPORT = qw(qv); -$VERSION = 0.37; # stop using CVS and switch to subversion +$VERSION = 0.39; # stop using CVS and switch to subversion $CLASS = 'version'; @@ -214,7 +214,17 @@ were used: In other words, the version will be automatically parsed out of the string, and it will be quoted to preserve the meaning CVS normally -carries for versions. +carries for versions. The CVS $Revision$ increments differently from +numeric versions (i.e. 1.10 follows 1.9), so it must be handled as if +it were a L. + +New in 0.38, a new version object can be created as a copy of an existing +version object: + + $v1 = version->new(12.3); + $v2 = version->new($v1); + +and $v1 and $v2 will be identical. =back @@ -236,11 +246,11 @@ either will yield the same version number. =back -For the subsequent examples, the following two objects will be used: +For the subsequent examples, the following three objects will be used: - $ver = version->new("1.2.3"); # see "Quoting" below - $alpha = version->new("1.2_3"); # see "Alpha versions" below - $nver = version->new(1.2); # see "Numeric Versions" above + $ver = version->new("1.2.3.4"); # see "Quoting" below + $alpha = version->new("1.2.3_4"); # see "Alpha versions" below + $nver = version->new(1.2); # see "Numeric Versions" above =over 4 @@ -388,7 +398,7 @@ having three places between subversions. The complicating factor is that in bare numbers (i.e. unquoted), the underscore is a legal numeric character and is automatically stripped by the Perl tokenizer before the version code is called. However, if -a number containing a single decimal and an underscore is quoted, i.e. +a number containing one or more decimals and an underscore is quoted, i.e. not bare, that is considered a L and the underscore is significant. @@ -451,6 +461,20 @@ As a matter of fact, if is also true that where the subversion is identical but the alpha release is less than the non-alpha release. +Alpha versions with a single decimal place will be treated exactly as if +they were L, for parsing purposes. The stringification for +alpha versions with a single decimal place may seem suprising, since any +trailing zeros will visible. For example, the above $alphaver will print as + + 12.300_100 + +Alpha versions with more than a single decimal place will be treated +exactly as if they were L, and will display without any +trailing (or leading) zeros, in the L form. For example, + + $newver = version->new("12.3.1_1"); + print $newver; # 12.3.1_1 + =head2 Replacement UNIVERSAL::VERSION In addition to the version objects, this modules also replaces the core @@ -481,6 +505,17 @@ IMPORTANT NOTE: This may mean that code which searches for a specific string (to determine whether a given module is available) may need to be changed. +The replacement UNIVERSAL::VERSION, when used as a function, like this: + + print $module->VERSION; + +will follow the stringification rules; i.e. Numeric versions will be displayed +with the numified format, and the rest will be displayed with the Normal +format. Technically, the $module->VERSION function returns a string (PV) that +can be converted to a number following the normal Perl rules, when used in a +numeric context. + + =head1 EXPORT qv - quoted version initialization operator diff --git a/lib/version.t b/lib/version.t index dd8cb67..c91d988 100644 --- a/lib/version.t +++ b/lib/version.t @@ -4,7 +4,7 @@ ######################### -use Test::More tests => 164; +use Test::More tests => 168; diag "Tests with base class" unless $ENV{PERL_CORE}; @@ -43,12 +43,12 @@ sub BaseTests { $version = $CLASS->new(5.005_03); is ( "$version" , "5.5.30" , '5.005_03 eq 5.5.30' ); $version = $CLASS->new(1.23); - is ( "$version" , "1.23" , '1.23 eq "1.23"' ); + is ( "$version" , "1.230" , '1.23 eq "1.230"' ); # Test quoted number processing diag "tests with quoted numbers" unless $ENV{PERL_CORE}; $version = $CLASS->new("5.005_03"); - is ( "$version" , "5.5_3" , '"5.005_03" eq "5.5_3"' ); + is ( "$version" , "5.5_30" , '"5.005_03" eq "5.5_30"' ); $version = $CLASS->new("v1.23"); is ( "$version" , "1.23.0" , '"v1.23" eq "1.23.0"' ); @@ -72,7 +72,7 @@ sub BaseTests { "Invalid version format (underscores before decimal)"); $version = $CLASS->new("99 and 44/100 pure"); - ok ("$version" eq "99", '$version eq "99.0.0"'); + ok ("$version" eq "99.000", '$version eq "99.000"'); ok ($version->numify == 99.0, '$version->numify == 99.0'); $version = $CLASS->new("something"); @@ -177,22 +177,22 @@ sub BaseTests { ok ( $new_version < $version, '$new_version < $version' ); ok ( $version != $new_version, '$version != $new_version' ); - $version = $CLASS->new("1.2.4"); - $new_version = $CLASS->new("1.2_4"); + $version = $CLASS->new("1.2.3.4"); + $new_version = $CLASS->new("1.2.3_4"); diag "tests with alpha-style objects with same subversion" unless $ENV{PERL_CORE}; ok ( $version > $new_version, '$version > $new_version' ); ok ( $new_version < $version, '$new_version < $version' ); ok ( $version != $new_version, '$version != $new_version' ); diag "test implicit [in]equality" unless $ENV{PERL_CORE}; - $version = $CLASS->new("v1.2"); - $new_version = $CLASS->new("1.2.0"); + $version = $CLASS->new("v1.2.3"); + $new_version = $CLASS->new("1.2.3.0"); ok ( $version == $new_version, '$version == $new_version' ); - $new_version = $CLASS->new("1.2_0"); + $new_version = $CLASS->new("1.2.3_0"); ok ( $version == $new_version, '$version == $new_version' ); - $new_version = $CLASS->new("1.2.1"); + $new_version = $CLASS->new("1.2.3.1"); ok ( $version < $new_version, '$version < $new_version' ); - $new_version = $CLASS->new("1.2_1"); + $new_version = $CLASS->new("1.2.3_1"); ok ( $version < $new_version, '$version < $new_version' ); $new_version = $CLASS->new("1.1.999"); ok ( $version > $new_version, '$version > $new_version' ); @@ -212,6 +212,12 @@ sub BaseTests { $version = qv(1.2); ok ( $version eq "1.2.0", 'qv(1.2) eq "1.2.0"' ); + # test creation from existing version object + diag "create new from existing version" unless $ENV{PERL_CORE}; + ok (eval {$new_version = version->new($version)}, + "new from existing object"); + ok ($new_version == $version, "duped object identical"); + # test the CVS revision mode diag "testing CVS Revision" unless $ENV{PERL_CORE}; $version = new version qw$Revision: 1.2$; @@ -221,16 +227,13 @@ sub BaseTests { diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE}; # we know this file is here since we require it ourselves - $version = $CLASS->new( $Test::More::VERSION ); + $version = $Test::More::VERSION; eval "use Test::More $version"; unlike($@, qr/Test::More version $version/, 'Replacement eval works with exact version'); - $version = $CLASS->new( $Test::More::VERSION+0.01 ); # this should fail even with old UNIVERSAL::VERSION - my $testeval = "use Test::More ". - ( $]<5.6 ? $version->numify() #why is this a problem??? - : $version ); - eval $testeval; + $version = $Test::More::VERSION+0.01; # this should fail even with old UNIVERSAL::VERSION + eval "use Test::More $version"; like($@, qr/Test::More version $version/, 'Replacement eval works with incremented version'); diff --git a/t/comp/use.t b/t/comp/use.t index dc3265b..7bb1cbd 100755 --- a/t/comp/use.t +++ b/t/comp/use.t @@ -111,7 +111,7 @@ print "ok ",$i++,"\n"; print "ok ",$i++,"\n"; eval "use lib v100.105"; - unless ($@ =~ /lib version 100.105 \(100\.105\.0\) required--this is only version 35.36 \(35\.360\.0\)/) { + unless ($@ =~ /lib version 100.105 \(100\.105\.0\) required--this is only version 35.360 \(35\.360\.0\)/) { print "not "; } print "ok ",$i++,"\n"; @@ -121,7 +121,7 @@ print "ok ",$i++,"\n"; print "ok ",$i++,"\n"; eval "use lib 100.105"; - unless ($@ =~ /lib version 100.105 \(100\.105\.0\) required--this is only version 35.36 \(35\.360\.0\)/) { + unless ($@ =~ /lib version 100.105 \(100\.105\.0\) required--this is only version 35.360 \(35\.360\.0\)/) { print "not "; } print "ok ",$i++,"\n"; @@ -132,7 +132,7 @@ print "ok ",$i++,"\n"; print "ok ",$i++,"\n"; eval "use lib v100.105"; - unless ($@ =~ /lib version 100.105 \(100\.105\.0\) required--this is only version 35.36 \(35\.360\.0\)/) { + unless ($@ =~ /lib version 100.105 \(100\.105\.0\) required--this is only version 35.360 \(35\.360\.0\)/) { print "not "; } print "ok ",$i++,"\n"; @@ -142,7 +142,7 @@ print "ok ",$i++,"\n"; print "ok ",$i++,"\n"; eval "use lib 100.105"; - unless ($@ =~ /lib version 100.105 \(100\.105\.0\) required--this is only version 35.36 \(35\.360\.0\)/) { + unless ($@ =~ /lib version 100.105 \(100\.105\.0\) required--this is only version 35.360 \(35\.360\.0\)/) { print "not "; } print "ok ",$i++,"\n"; diff --git a/universal.c b/universal.c index 78d30cb..6b2214d 100644 --- a/universal.c +++ b/universal.c @@ -374,10 +374,10 @@ XS(XS_UNIVERSAL_VERSION) vnumify(req),vnormal(req),vnumify(sv),vnormal(sv)); } - if (sv == (SV*)&PL_sv_undef) { - ST(0) = sv; - } else { + if ( sv_derived_from(sv, "version") ) { ST(0) = vnumify(sv); + } else { + ST(0) = sv; } XSRETURN(1); diff --git a/util.c b/util.c index 824b3a0..9c12c12 100644 --- a/util.c +++ b/util.c @@ -3730,8 +3730,8 @@ Perl_scan_version(pTHX_ char *s, SV *rv, bool qv) * point of a version originally created with a bare * floating point number, i.e. not quoted in any way */ - if ( !qv && s > start+1 && saw_period == 1 && !saw_under ) { - mult = 100; + if ( !qv && s > start+1 && saw_period == 1 ) { + mult *= 100; while ( s < end ) { orev = rev; rev += (*s - '0') * mult; @@ -3763,7 +3763,7 @@ Perl_scan_version(pTHX_ char *s, SV *rv, bool qv) break; } while ( isDIGIT(*pos) ) { - if ( !saw_under && saw_period == 1 && pos-s == 3 ) + if ( saw_period == 1 && pos-s == 3 ) break; pos++; } @@ -3883,14 +3883,26 @@ Perl_vnumify(pTHX_ SV *vs) } digit = SvIVX(*av_fetch((AV *)vs, 0, 0)); Perl_sv_setpvf(aTHX_ sv,"%d.", (int)PERL_ABS(digit)); - for ( i = 1 ; i <= len ; i++ ) + for ( i = 1 ; i < len ; i++ ) { digit = SvIVX(*av_fetch((AV *)vs, i, 0)); Perl_sv_catpvf(aTHX_ sv,"%03d", (int)PERL_ABS(digit)); } - if ( len == 0 ) + + if ( len > 0 ) + { + digit = SvIVX(*av_fetch((AV *)vs, len, 0)); + + /* Don't display any additional trailing zeros */ + if ( (int)PERL_ABS(digit) != 0 || len == 1 ) + { + Perl_sv_catpvf(aTHX_ sv,"%03d", (int)PERL_ABS(digit)); + } + } + else /* len == 0 */ + { Perl_sv_catpv(aTHX_ sv,"000"); - sv_setnv(sv, SvNV(sv)); + } return sv; }