@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';
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<Quoted Version>.
+
+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
=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
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<Alpha Version> and the underscore is
significant.
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<Numeric Versions>, 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<Quoted Versions>, and will display without any
+trailing (or leading) zeros, in the L<Version Normal> 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
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
#########################
-use Test::More tests => 164;
+use Test::More tests => 168;
diag "Tests with base class" unless $ENV{PERL_CORE};
$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"' );
"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");
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' );
$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$;
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');
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";
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";
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";
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";
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);
* 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;
break;
}
while ( isDIGIT(*pos) ) {
- if ( !saw_under && saw_period == 1 && pos-s == 3 )
+ if ( saw_period == 1 && pos-s == 3 )
break;
pos++;
}
}
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;
}
projects / p5sagit/p5-mst-13.2.git / commitdiff