use 5.005_03;
use strict;
+require Exporter;
require DynaLoader;
-use vars qw(@ISA $VERSION $CLASS);
+use vars qw(@ISA $VERSION $CLASS @EXPORT);
-@ISA = qw(DynaLoader);
+@ISA = qw(Exporter DynaLoader);
-$VERSION = 0.29; # stop using CVS and switch to subversion
+@EXPORT = qw(qv);
+
+$VERSION = 0.36; # stop using CVS and switch to subversion
$CLASS = 'version';
$version = new version "12.2.1"; # must be quoted!
print $version; # 12.2.1
print $version->numify; # 12.002001
- if ( $version gt "v12.2" ) # true
+ if ( $version gt "12.2" ) # true
- $vstring = new version qw(v1.2); # must be quoted!
+ $vstring = new version qw(1.2); # must be quoted!
print $vstring; # 1.2
$alphaver = new version "1.2_3"; # must be quoted!
print $alphaver; # 1.2_3
print $alphaver->is_alpha(); # true
+
+ $ver = qv(1.2); # 1.2.0
+ $ver = qv("1.2"); # 1.2.0
$perlver = new version 5.005_03; # must not be quoted!
print $perlver; # 5.5.30
Overloaded version objects for all versions of Perl. This module
implements all of the features of version objects which will be part
-of Perl 5.10.0 except automatic v-string handling. See L<"Quoting">.
+of Perl 5.10.0 except automatic version object creation.
=head2 What IS a version
Any initial parameter which "looks like a number", see L<Numeric
Versions>.
-=item * V-String Versions
+=item * Quoted Versions
-Any initial parameter which contains more than one decimal point,
-contains an embedded underscore, or has a leading 'v' see L<V-String
-Versions>.
+Any initial parameter which contains more than one decimal point
+or contains an embedded underscore, see L<Quoted Versions>. The
+most recent development version of Perl (5.9.x) and the next major
+release (5.10.0) will automatically create version objects for bare
+numbers containing more than one decimal point.
=back
$v = new version 1.002003; # 1.2.3
$v2 = new version "1.2.3"; # 1.2.3
- $v3 = new version v1.2.3; # 1.2.3 for Perl > v5.8.0
- $v4 = new version 1.2.3; # 1.2.3 for Perl > v5.8.0
+ $v3 = new version 1.2.3; # 1.2.3 for Perl > 5.8.0
+Note that the default stringification will display at least three sub
+terms (to ensure that appropriate round-trip processing is possible).
Please see L<"Quoting"> for more details on how Perl will parse various
input values.
However, see L<New Operator> for one case where non-numeric text is
acceptable when initializing version objects.
+=head2 What about v-strings?
+
+Beginning with Perl 5.6.0, an alternate method to code arbitrary strings
+of bytes was introduced, called v-strings. They were intended to be an
+easy way to enter, for example, Unicode strings (which contain two bytes
+per character). Some programs have used them to encode printer control
+characters (e.g. CRLF). They were also intended to be used for $VERSION.
+Their use has been problematic from the start and they will be phased out
+beginning in Perl 5.10.0.
+
+There are two ways to enter v-strings: a bare number with two or more
+decimal places, or a bare number with one or more decimal places and a
+leading 'v' character (also bare). For example:
+
+ $vs1 = 1.2.3; # encoded as \1\2\3
+ $vs2 = v1.2; # encoded as \1\2
+
+The first of those two syntaxes is destined to be the default way to create
+a version object in 5.10.0, whereas the second will issue a mandatory
+deprecation warning beginning at the same time.
+
+Consequently, the use of v-strings to initialize version objects with
+this module is only possible with Perl 5.8.1 (which will contain special
+code to enable it). Their use is B<strongly> discouraged in all
+circumstances(especially the leading 'v' style), since the meaning will
+change depending on which Perl you are running. It is better to use
+L<"Quoted Versions"> to ensure the proper interpretation.
+
=head2 Numeric Versions
-These correspond to historical versions of Perl itself prior to v5.6.0,
+These correspond to historical versions of Perl itself prior to 5.6.0,
as well as all other modules which follow the Camel rules for the
$VERSION scalar. A numeric version is initialized with what looks like
a floating point number. Leading zeros B<are> significant and trailing
$v = new version 1.002; # 1.2
$v = new version 1.0023; # 1.2.300
$v = new version 1.00203; # 1.2.30
- $v = new version 1.002_03; # 1.2.30 See L<"Quoting">
+ $v = new version 1.002_03; # 1.2.30 See "Quoting"
$v = new version 1.002003; # 1.2.3
All of the preceeding examples except the second to last are true
whether or not the input value is quoted. The important feature is that
the input value contains only a single decimal.
-=head2 V-String Versions
+=head2 Quoted Versions
These are the newest form of versions, and correspond to Perl's own
-version style beginning with v5.6.0. Starting with Perl v5.10.0,
-this is likely to be the preferred form. This method requires that
-the input parameter be quoted, although Perl > v5.9.0 can use bare
-v-strings as a special form of quoting.
-
-Unlike L<Numeric Versions>, V-String Versions must either have more than
-a single decimal point, e.g. "5.6.1" B<or> must be prefaced by a "v"
-like this "v5.6" (much like v-string notation). In fact, with the
-newest Perl v-strings themselves can be used to initialize version
-objects. Also unlike L<Numeric Versions>, leading zeros are B<not>
-significant, and trailing zeros must be explicitely specified (i.e.
-will not be automatically added). In addition, the subversions are
-not enforced to be three decimal places.
+version style beginning with 5.6.0. Starting with Perl 5.10.0,
+and most likely Perl 6, this is likely to be the preferred form. This
+method requires that the input parameter be quoted, although Perl's after
+5.9.0 can use bare numbers with multiple decimal places as a special form
+of quoting.
+
+Unlike L<Numeric Versions>, Quoted Versions may have more than
+a single decimal point, e.g. "5.6.1" but must be quoted like this "5.6" in
+order to prevent the Numeric Version interpretation. Also unlike
+L<Numeric Versions>, leading zeros are B<not> significant, and trailing
+zeros must be explicitely specified (i.e. will not be automatically added).
+In addition, the subversions are not enforced to be three decimal places.
So, for example:
- $v = new version "v1.2"; # 1.2
- $v = new version "v1.002"; # 1.2
+ $v = new version "1.002"; # 1.2
$v = new version "1.2.3"; # 1.2.3
- $v = new version "v1.2.3"; # 1.2.3
- $v = new version "v1.0003"; # 1.3
+ $v = new version "1.2.3"; # 1.2.3
+ $v = new version "1.0003"; # 1.3
-In additional to conventional versions, V-String Versions can be
+In addition to conventional versions, Quoted Versions can be
used to create L<Alpha Versions>.
-In general, V-String Versions permit the greatest amount of freedom
+In general, Quoted Versions permit the greatest amount of freedom
to specify a version, whereas Numeric Versions enforce a certain
uniformity. See also L<New Operator> for an additional method of
initializing version objects.
use the CVS variable $Revision, which is automatically incremented by
CVS every time the file is committed to the repository.
-=back
-
In order to facilitate this feature, the following
code can be employed:
and the version object will be created as if the following code
were used:
- $VERSION = new version "v2.7";
+ $VERSION = new version "2.7";
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.
+=back
+
+=over 4
+
+=item * qv()
+
+An alternate way to create a new version object is through the exported
+qv() sub. This is not strictly like other q? operators (like qq, qw),
+in that the only delimiters supported are parentheses (or spaces). It is
+the best way to initialize a short version without triggering the floating
+point interpretation. For example:
+
+ $v1 = qv(1.2); # 1.2.0
+ $v2 = qv("1.2"); # also 1.2.0
+
+As you can see, either a bare number or a quoted string can be used, and
+either will yield the same version number.
+
+=back
+
For the subsequent examples, the following two objects will be used:
$ver = new version "1.2.3"; # see "Quoting" below
Any time a version object is used as a string, a stringified
representation is returned in reduced form (no extraneous zeros):
-=back
-
print $ver->stringify; # prints 1.2.3
print $ver; # same thing
+In order to preserve the meaning of the processed version, the
+default stringified representation will always contain at least
+three sub terms. In other words, the following is guaranteed to
+always be true:
+
+ my $newver = version->new($ver->stringify);
+ if ($newver eq $ver ) # always true
+ {...}
+
+If the string representation "looked like a number" then there is
+a possibility that creating a new version object from that would use
+the Numeric Version interpretation, If a version object contains only
+two terms internally, it will stringify with an explicit '.0' appended.
+
+=back
+
=over 4
=item * Numification
print $ver->numify; # prints 1.002003
+Unlike the stringification operator, there is never any need to append
+trailing zeros to preserve the correct version value.
+
+=back
+
+=over 4
+
=item * Comparison operators
Both cmp and <=> operators perform the same comparison between terms
generates all of the other comparison operators based on those two.
In addition to the obvious equalities listed below, appending a single
trailing 0 term does not change the value of a version for comparison
-purposes. In other words "v1.2" and "v1.2.0" are identical versions.
+purposes. In other words "v1.2" and "1.2.0" will compare as identical.
For example, the following relations hold:
$ver != 1.3 $ver ne "1.3" true
$ver == 1.2 $ver eq "1.2" false
$ver == 1.2.3 $ver eq "1.2.3" see discussion below
- $ver == v1.2.3 $ver eq "v1.2.3" ditto
-In versions of Perl prior to the 5.9.0 development releases, it is not
-permitted to use bare v-strings in either form, due to the nature of Perl's
-parsing operation. After that version (and in the stable 5.10.0 release),
-v-strings can be used with version objects without problem, see L<"Quoting">
-for more discussion of this topic. In the case of the last two lines of
-the table above, only the string comparison will be true; the numerical
-comparison will test false. However, you can do this:
+It is probably best to chose either the numeric notation or the string
+notation and stick with it, to reduce confusion. Perl6 version objects
+B<may> only support numeric comparisons. See also L<"Quoting">.
- $ver == "1.2.3" or $ver == "v1.2.3" # both true
+=back
-even though you are doing a "numeric" comparison with a "string" value.
-It is probably best to chose either the numeric notation or the string
-notation and stick with it, to reduce confusion. See also L<"Quoting">.
+=over 4
=item * Logical Operators
$vobj = new version $something;
if ( $vobj ) # true only if $something was non-blank
-You can also test whether a version object is a L<Alpha version>, for
+You can also test whether a version object is an L<Alpha version>, for
example to prevent the use of some feature not present in the main
release:
$V2 = new version 100/9; # Integer overflow in decimal number
print $V2; # yields 11_1285418553
-Perl 5.9.0 and beyond will be able to automatically quote v-strings
-(which may become the recommended notation), but that is not possible in
-earlier versions of Perl. In other words:
+Perl 5.8.1 and beyond will be able to automatically quote v-strings
+(although a warning will be issued under 5.9.x and 5.10.0), but that
+is not possible in earlier versions of Perl. In other words:
$version = new version "v2.5.4"; # legal in all versions of Perl
- $newvers = new version v2.5.4; # legal only in Perl > 5.9.0
+ $newvers = new version v2.5.4; # legal only in Perl > 5.8.1
=head2 Types of Versions Objects
using the Revision number from the primary file in a distribution, see
L<ExtUtils::MakeMaker/"VERSION_FROM">.
-=item * alpha versions
+=item * Alpha versions
For module authors using CPAN, the convention has been to note
unstable releases with an underscore in the version string, see
=head1 EXPORT
-None by default.
+qv - quoted version initialization operator
=head1 AUTHOR
#! /usr/local/perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
-# $Revision: 2.4 $
#########################
-use Test::More tests => 73;
-use_ok("version"); # If we made it this far, we are ok.
-
-my ($version, $new_version);
-#########################
-
-# Insert your test code below, the Test module is use()ed here so read
-# its man page ( perldoc Test ) for help writing this test script.
-
-# Test bare number processing
-diag "tests with bare numbers" unless $ENV{PERL_CORE};
-$version = new version 5.005_03;
-is ( "$version" , "5.5.30" , '5.005_03 eq 5.5.30' );
-$version = new version 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 = new version "5.005_03";
-is ( "$version" , "5.5_3" , '"5.005_03" eq "5.5_3"' );
-$version = new version "v1.23";
-is ( "$version" , "1.23" , '"v1.23" eq "1.23"' );
-
-# Test stringify operator
-diag "tests with stringify" unless $ENV{PERL_CORE};
-$version = new version "5.005";
-is ( "$version" , "5.5" , '5.005 eq 5.5' );
-$version = new version "5.006.001";
-is ( "$version" , "5.6.1" , '5.006.001 eq 5.6.1' );
-$version = new version "1.2.3_4";
-is ( "$version" , "1.2.3_4" , 'alpha version 1.2.3_4 eq 1.2.3_4' );
-
-# test illegal formats
-diag "test illegal formats" unless $ENV{PERL_CORE};
-eval {my $version = new version "1.2_3_4";};
-like($@, qr/multiple underscores/,
- "Invalid version format (multiple underscores)");
-
-eval {my $version = new version "1.2_3.4";};
-like($@, qr/underscores before decimal/,
- "Invalid version format (underscores before decimal)");
-
-$version = new version "99 and 44/100 pure";
-ok ("$version" eq "99.0", '$version eq "99.0"');
-ok ($version->numify == 99.0, '$version->numify == 99.0');
-
-$version = new version "something";
-ok (defined $version, 'defined $version');
-
-# reset the test object to something reasonable
-$version = new version "1.2.3";
-
-# Test boolean operator
-ok ($version, 'boolean');
-
-# Test ref operator
-ok (ref($version) eq 'version','ref operator');
-
-# Test comparison operators with self
-diag "tests with self" unless $ENV{PERL_CORE};
-ok ( $version eq $version, '$version eq $version' );
-is ( $version cmp $version, 0, '$version cmp $version == 0' );
-ok ( $version == $version, '$version == $version' );
-
-# test first with non-object
-$version = new version "5.006.001";
-$new_version = "5.8.0";
-diag "tests with non-objects" unless $ENV{PERL_CORE};
-ok ( $version ne $new_version, '$version ne $new_version' );
-ok ( $version lt $new_version, '$version lt $new_version' );
-ok ( $new_version gt $version, '$new_version gt $version' );
-ok ( ref(\$new_version) eq 'SCALAR', 'no auto-upgrade');
-$new_version = "$version";
-ok ( $version eq $new_version, '$version eq $new_version' );
-ok ( $new_version eq $version, '$new_version eq $version' );
-
-# now test with existing object
-$new_version = new version "5.8.0";
-diag "tests with objects" unless $ENV{PERL_CORE};
-ok ( $version ne $new_version, '$version ne $new_version' );
-ok ( $version lt $new_version, '$version lt $new_version' );
-ok ( $new_version gt $version, '$new_version gt $version' );
-$new_version = new version "$version";
-ok ( $version eq $new_version, '$version eq $new_version' );
+use Test::More tests => 166;
-# Test Numeric Comparison operators
-# test first with non-object
-$new_version = "5.8.0";
-diag "numeric tests with non-objects" unless $ENV{PERL_CORE};
-ok ( $version == $version, '$version == $version' );
-ok ( $version < $new_version, '$version < $new_version' );
-ok ( $new_version > $version, '$new_version > $version' );
-ok ( $version != $new_version, '$version != $new_version' );
-
-# now test with existing object
-$new_version = new version $new_version;
-diag "numeric tests with objects" 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' );
-
-# now test with actual numbers
-diag "numeric tests with numbers" unless $ENV{PERL_CORE};
-ok ( $version->numify() == 5.006001, '$version->numify() == 5.006001' );
-ok ( $version->numify() <= 5.006001, '$version->numify() <= 5.006001' );
-ok ( $version->numify() < 5.008, '$version->numify() < 5.008' );
-#ok ( $version->numify() > v5.005_02, '$version->numify() > 5.005_02' );
-
-# test with long decimals
-diag "Tests with extended decimal versions" unless $ENV{PERL_CORE};
-$version = new version 1.002003;
-ok ( $version eq "1.2.3", '$version eq "1.2.3"');
-ok ( $version->numify == 1.002003, '$version->numify == 1.002003');
-$version = new version "2002.09.30.1";
-ok ( $version eq "2002.9.30.1",'$version eq 2002.9.30.1');
-ok ( $version->numify == 2002.009030001,
- '$version->numify == 2002.009030001');
-
-# now test with alpha version form with string
-$version = new version "1.2.3";
-$new_version = "1.2.3_4";
-diag "tests with alpha-style non-objects" unless $ENV{PERL_CORE};
-ok ( $version lt $new_version, '$version lt $new_version' );
-ok ( $new_version gt $version, '$new_version gt $version' );
-ok ( $version ne $new_version, '$version ne $new_version' );
-
-$version = new version "1.2.4";
-diag "numeric tests with alpha-style non-objects" 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' );
-
-# now test with alpha version form with object
-$version = new version "1.2.3";
-$new_version = new version "1.2.3_4";
-diag "tests with alpha-style objects" 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' );
-ok ( !$version->is_alpha, '!$version->is_alpha');
-ok ( $new_version->is_alpha, '$new_version->is_alpha');
-
-$version = new version "1.2.4";
-diag "tests with alpha-style objects" 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' );
-
-$version = new version "1.2.4";
-$new_version = new version "1.2_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 = new version "v1.2";
-$new_version = new version "1.2.0";
-ok ( $version == $new_version, '$version == $new_version' );
-$new_version = new version "1.2_0";
-ok ( $version == $new_version, '$version == $new_version' );
-$new_version = new version "1.2.1";
-ok ( $version < $new_version, '$version < $new_version' );
-$new_version = new version "1.2_1";
-ok ( $version < $new_version, '$version < $new_version' );
-$new_version = new version "1.1.999";
-ok ( $version > $new_version, '$version > $new_version' );
-
-# that which is not expressly permitted is forbidden
-diag "forbidden operations" unless $ENV{PERL_CORE};
-ok ( !eval { $version++ }, "noop ++" );
-ok ( !eval { $version-- }, "noop --" );
-ok ( !eval { $version/1 }, "noop /" );
-ok ( !eval { $version*3 }, "noop *" );
-ok ( !eval { abs($version) }, "noop abs" );
-
-# test reformed UNIVERSAL::VERSION
-diag "Replacement UNIVERSAL::VERSION tests" unless $ENV{PERL_CORE};
-
-# we know this file is here since we require it ourselves
-$version = new version $Test::More::VERSION;
-eval "use Test::More $version";
-unlike($@, qr/Test::More version $version required/,
- 'Replacement eval works with exact version');
-
-$version = new 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 required/,
- 'Replacement eval works with incremented version');
-
-chop($version); # shorten by 1 digit, should still succeed
-eval "use Test::More $version";
-unlike($@, qr/Test::More version $version required/,
- 'Replacement eval works with single digit');
-
-$version += 0.1; # this would fail with old UNIVERSAL::VERSION
-eval "use Test::More $version";
-unlike($@, qr/Test::More version $version required/,
- 'Replacement eval works with incremented digit');
+diag "Tests with base class" unless $ENV{PERL_CORE};
+use_ok("version"); # If we made it this far, we are ok.
+BaseTests("version");
+
+diag "Tests with empty derived class" unless $ENV{PERL_CORE};
+
+package version::Empty;
+use vars qw($VERSION @ISA);
+use Exporter;
+use version 0.30;
+@ISA = qw(Exporter version);
+$VERSION = 0.01;
+
+package main;
+my $testobj = new version::Empty 1.002_003;
+isa_ok( $testobj, "version::Empty" );
+ok( $testobj->numify == 1.002003, "Numified correctly" );
+ok( $testobj->stringify eq "1.2.3", "Stringified correctly" );
+
+my $verobj = new version "1.2.4";
+ok( $verobj > $testobj, "Comparison vs parent class" );
+ok( $verobj gt $testobj, "Comparison vs parent class" );
+BaseTests("version::Empty");
+
+sub BaseTests {
+
+ my $CLASS = shift;
+
+ # Insert your test code below, the Test module is use()ed here so read
+ # its man page ( perldoc Test ) for help writing this test script.
+
+ # Test bare number processing
+ diag "tests with bare numbers" 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.230.0" , '1.23 eq "1.230.0"' );
+
+ # 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"' );
+ $version = $CLASS->new("v1.23");
+ is ( "$version" , "1.23.0" , '"v1.23" eq "1.23.0"' );
+
+ # Test stringify operator
+ diag "tests with stringify" unless $ENV{PERL_CORE};
+ $version = $CLASS->new("5.005");
+ is ( "$version" , "5.5.0" , '5.005 eq 5.5' );
+ $version = $CLASS->new("5.006.001");
+ is ( "$version" , "5.6.1" , '5.006.001 eq 5.6.1' );
+ $version = $CLASS->new("1.2.3_4");
+ is ( "$version" , "1.2.3_4" , 'alpha version 1.2.3_4 eq 1.2.3_4' );
+
+ # test illegal formats
+ diag "test illegal formats" unless $ENV{PERL_CORE};
+ eval {my $version = $CLASS->new("1.2_3_4")};
+ like($@, qr/multiple underscores/,
+ "Invalid version format (multiple underscores)");
+
+ eval {my $version = $CLASS->new("1.2_3.4")};
+ like($@, qr/underscores before decimal/,
+ "Invalid version format (underscores before decimal)");
+
+ $version = $CLASS->new("99 and 44/100 pure");
+ ok ("$version" eq "99.0.0", '$version eq "99.0.0"');
+ ok ($version->numify == 99.0, '$version->numify == 99.0');
+
+ $version = $CLASS->new("something");
+ ok (defined $version, 'defined $version');
+
+ # reset the test object to something reasonable
+ $version = $CLASS->new("1.2.3");
+
+ # Test boolean operator
+ ok ($version, 'boolean');
+
+ # Test class membership
+ isa_ok ( $version, "version" );
+
+ # Test comparison operators with self
+ diag "tests with self" unless $ENV{PERL_CORE};
+ ok ( $version eq $version, '$version eq $version' );
+ is ( $version cmp $version, 0, '$version cmp $version == 0' );
+ ok ( $version == $version, '$version == $version' );
+
+ # test first with non-object
+ $version = $CLASS->new("5.006.001");
+ $new_version = "5.8.0";
+ diag "tests with non-objects" unless $ENV{PERL_CORE};
+ ok ( $version ne $new_version, '$version ne $new_version' );
+ ok ( $version lt $new_version, '$version lt $new_version' );
+ ok ( $new_version gt $version, '$new_version gt $version' );
+ ok ( ref(\$new_version) eq 'SCALAR', 'no auto-upgrade');
+ $new_version = "$version";
+ ok ( $version eq $new_version, '$version eq $new_version' );
+ ok ( $new_version eq $version, '$new_version eq $version' );
+
+ # now test with existing object
+ $new_version = $CLASS->new("5.8.0");
+ diag "tests with objects" unless $ENV{PERL_CORE};
+ ok ( $version ne $new_version, '$version ne $new_version' );
+ ok ( $version lt $new_version, '$version lt $new_version' );
+ ok ( $new_version gt $version, '$new_version gt $version' );
+ $new_version = $CLASS->new("$version");
+ ok ( $version eq $new_version, '$version eq $new_version' );
+
+ # Test Numeric Comparison operators
+ # test first with non-object
+ $new_version = "5.8.0";
+ diag "numeric tests with non-objects" unless $ENV{PERL_CORE};
+ ok ( $version == $version, '$version == $version' );
+ ok ( $version < $new_version, '$version < $new_version' );
+ ok ( $new_version > $version, '$new_version > $version' );
+ ok ( $version != $new_version, '$version != $new_version' );
+
+ # now test with existing object
+ $new_version = $CLASS->new($new_version);
+ diag "numeric tests with objects" 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' );
+
+ # now test with actual numbers
+ diag "numeric tests with numbers" unless $ENV{PERL_CORE};
+ ok ( $version->numify() == 5.006001, '$version->numify() == 5.006001' );
+ ok ( $version->numify() <= 5.006001, '$version->numify() <= 5.006001' );
+ ok ( $version->numify() < 5.008, '$version->numify() < 5.008' );
+ #ok ( $version->numify() > v5.005_02, '$version->numify() > 5.005_02' );
+
+ # test with long decimals
+ diag "Tests with extended decimal versions" unless $ENV{PERL_CORE};
+ $version = $CLASS->new(1.002003);
+ ok ( $version eq "1.2.3", '$version eq "1.2.3"');
+ ok ( $version->numify == 1.002003, '$version->numify == 1.002003');
+ $version = $CLASS->new("2002.09.30.1");
+ ok ( $version eq "2002.9.30.1",'$version eq 2002.9.30.1');
+ ok ( $version->numify == 2002.009030001,
+ '$version->numify == 2002.009030001');
+
+ # now test with alpha version form with string
+ $version = $CLASS->new("1.2.3");
+ $new_version = "1.2.3_4";
+ diag "tests with alpha-style non-objects" unless $ENV{PERL_CORE};
+ ok ( $version lt $new_version, '$version lt $new_version' );
+ ok ( $new_version gt $version, '$new_version gt $version' );
+ ok ( $version ne $new_version, '$version ne $new_version' );
+
+ $version = $CLASS->new("1.2.4");
+ diag "numeric tests with alpha-style non-objects" 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' );
+
+ # now test with alpha version form with object
+ $version = $CLASS->new("1.2.3");
+ $new_version = $CLASS->new("1.2.3_4");
+ diag "tests with alpha-style objects" 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' );
+ ok ( !$version->is_alpha, '!$version->is_alpha');
+ ok ( $new_version->is_alpha, '$new_version->is_alpha');
+
+ $version = $CLASS->new("1.2.4");
+ diag "tests with alpha-style objects" 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' );
+
+ $version = $CLASS->new("1.2.4");
+ $new_version = $CLASS->new("1.2_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");
+ ok ( $version == $new_version, '$version == $new_version' );
+ $new_version = $CLASS->new("1.2_0");
+ ok ( $version == $new_version, '$version == $new_version' );
+ $new_version = $CLASS->new("1.2.1");
+ ok ( $version < $new_version, '$version < $new_version' );
+ $new_version = $CLASS->new("1.2_1");
+ ok ( $version < $new_version, '$version < $new_version' );
+ $new_version = $CLASS->new("1.1.999");
+ ok ( $version > $new_version, '$version > $new_version' );
+
+ # that which is not expressly permitted is forbidden
+ diag "forbidden operations" unless $ENV{PERL_CORE};
+ ok ( !eval { ++$version }, "noop ++" );
+ ok ( !eval { --$version }, "noop --" );
+ ok ( !eval { $version/1 }, "noop /" );
+ ok ( !eval { $version*3 }, "noop *" );
+ ok ( !eval { abs($version) }, "noop abs" );
+
+ # test the qv() sub
+ diag "testing qv" unless $ENV{PERL_CORE};
+ $version = qv("1.2");
+ ok ( $version eq "1.2.0", 'qv("1.2") eq "1.2.0"' );
+ $version = qv(1.2);
+ ok ( $version eq "1.2.0", 'qv(1.2) eq "1.2.0"' );
+
+ # test the CVS revision mode
+ diag "testing CVS Revision" unless $ENV{PERL_CORE};
+ $version = new version qw$Revision: 1.2$;
+ ok ( $version eq "1.2.0", 'qw$Revision: 1.2$ eq 1.2.0' );
+
+ # test reformed UNIVERSAL::VERSION
+ 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 );
+ eval "use Test::More $version";
+ unlike($@, qr/Test::More version $version required/,
+ '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;
+ like($@, qr/Test::More version $version required/,
+ 'Replacement eval works with incremented version');
+
+ $version =~ s/...$//; #convert to string and remove trailing '.0'
+ chop($version); # shorten by 1 digit, should still succeed
+ eval "use Test::More $version";
+ unlike($@, qr/Test::More version $version required/,
+ 'Replacement eval works with single digit');
+
+ $version += 0.1; # this would fail with old UNIVERSAL::VERSION
+ eval "use Test::More $version";
+ unlike($@, qr/Test::More version $version required/,
+ 'Replacement eval works with incremented digit');
+
+SKIP: {
+ skip 'Cannot test v-strings with Perl < 5.8.1', 5
+ if $] < 5.008_001;
+ diag "Tests with v-strings" unless $ENV{PERL_CORE};
+ $version = $CLASS->new(1.2.3);
+ ok("$version" eq "1.2.3", '"$version" eq 1.2.3');
+ $version = $CLASS->new(1.0.0);
+ $new_version = $CLASS->new(1);
+ ok($version == $new_version, '$version == $new_version');
+ ok($version eq $new_version, '$version eq $new_version');
+ ok("$version" eq "$new_version", '"$version" eq "$new_version"');
+ $version = qv(1.2.3);
+ ok("$version" eq "1.2.3", 'v-string initialized qv()');
+ }
+}
Function must be called with an already existing SV like
- sv = NEWSV(92,0);
- s = scan_version(s,sv);
+ sv = newSV(0);
+ s = scan_version(s,SV *sv, bool qv);
Performs some preprocessing to the string to ensure that
it has the correct characteristics of a version. Flags the
object if it contains an underscore (which denotes this
-is a beta version).
+is a alpha version). The boolean qv denotes that the version
+should be interpreted as if it had multiple decimals, even if
+it doesn't.
=cut
*/
char *
-Perl_scan_version(pTHX_ char *s, SV *rv)
+Perl_scan_version(pTHX_ char *s, SV *rv, bool qv)
{
const char *start = s;
char *pos = s;
}
pos = s;
- if (*pos == 'v') pos++; /* get past 'v' */
+ if (*pos == 'v') {
+ pos++; /* get past 'v' */
+ qv = 1; /* force quoted version processing */
+ }
while (isDIGIT(*pos))
pos++;
if (!isALPHA(*pos)) {
I32 mult = 1;
I32 orev;
if ( s < pos && s > start && *(s-1) == '_' ) {
- mult *= -1; /* beta version */
+ mult *= -1; /* alpha version */
}
/* the following if() will only be true after the decimal
* point of a version originally created with a bare
* floating point number, i.e. not quoted in any way
*/
- if ( s > start+1 && saw_period == 1 && !saw_under ) {
+ if ( !qv && s > start+1 && saw_period == 1 && !saw_under ) {
mult = 100;
while ( s < end ) {
orev = rev;
Perl_new_version(pTHX_ SV *ver)
{
SV *rv = newSV(0);
- char *version;
- if ( SvNOK(ver) ) /* may get too much accuracy */
- {
- char tbuf[64];
- sprintf(tbuf,"%.9"NVgf, SvNVX(ver));
- version = savepv(tbuf);
- }
#ifdef SvVOK
- else if ( SvVOK(ver) ) { /* already a v-string */
+ if ( SvVOK(ver) ) { /* already a v-string */
+ char *version;
MAGIC* mg = mg_find(ver,PERL_MAGIC_vstring);
version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
+ sv_setpv(rv,version);
+ Safefree(version);
}
+ else {
#endif
- else /* must be a string or something like a string */
- {
- version = (char *)SvPV(ver,PL_na);
+ sv_setsv(rv,ver); /* make a duplicate */
+#ifdef SvVOK
}
- version = scan_version(version,rv);
+#endif
+ upg_version(rv);
return rv;
}
SV *
Perl_upg_version(pTHX_ SV *ver)
{
- char *version = savepvn(SvPVX(ver),SvCUR(ver));
+ char *version;
+ bool qv = 0;
+
+ if ( SvNOK(ver) ) /* may get too much accuracy */
+ {
+ char tbuf[64];
+ sprintf(tbuf,"%.9"NVgf, SvNVX(ver));
+ version = savepv(tbuf);
+ }
#ifdef SvVOK
- if ( SvVOK(ver) ) { /* already a v-string */
+ else if ( SvVOK(ver) ) { /* already a v-string */
MAGIC* mg = mg_find(ver,PERL_MAGIC_vstring);
version = savepvn( (const char*)mg->mg_ptr,mg->mg_len );
+ qv = 1;
}
#endif
- version = scan_version(version,ver);
+ else /* must be a string or something like a string */
+ {
+ STRLEN n_a;
+ version = savepv(SvPV(ver,n_a));
+ }
+ (void)scan_version(version, ver, qv);
+ Safefree(version);
return ver;
}
Perl_vnumify(pTHX_ SV *vs)
{
I32 i, len, digit;
- SV *sv = NEWSV(92,0);
+ SV *sv = newSV(0);
if ( SvROK(vs) )
vs = SvRV(vs);
len = av_len((AV *)vs);
Perl_vstringify(pTHX_ SV *vs)
{
I32 i, len, digit;
- SV *sv = NEWSV(92,0);
+ SV *sv = newSV(0);
if ( SvROK(vs) )
vs = SvRV(vs);
len = av_len((AV *)vs);
else
Perl_sv_catpvf(aTHX_ sv,".%"IVdf,(IV)digit);
}
- if ( len == 0 )
- Perl_sv_catpv(aTHX_ sv,".0");
+
+ if ( len <= 2 ) { /* short version, must be at least three */
+ for ( len = 2 - len; len != 0; len-- )
+ Perl_sv_catpv(aTHX_ sv,".0");
+ }
+
return sv;
}
{
I32 left = SvIV(*av_fetch((AV *)lsv,i,0));
I32 right = SvIV(*av_fetch((AV *)rsv,i,0));
- bool lbeta = left < 0 ? 1 : 0;
- bool rbeta = right < 0 ? 1 : 0;
- left = PERL_ABS(left);
- right = PERL_ABS(right);
- if ( left < right || (left == right && lbeta && !rbeta) )
+ bool lalpha = left < 0 ? 1 : 0;
+ bool ralpha = right < 0 ? 1 : 0;
+ left = abs(left);
+ right = abs(right);
+ if ( left < right || (left == right && lalpha && !ralpha) )
retval = -1;
- if ( left > right || (left == right && rbeta && !lbeta) )
+ if ( left > right || (left == right && ralpha && !lalpha) )
retval = +1;
i++;
}
- if ( l != r && retval == 0 ) /* possible match except for trailing 0 */
+ if ( l != r && retval == 0 ) /* possible match except for trailing 0's */
{
- if ( !( l < r && r-l == 1 && SvIV(*av_fetch((AV *)rsv,r,0)) == 0 ) &&
- !( l-r == 1 && SvIV(*av_fetch((AV *)lsv,l,0)) == 0 ) )
+ if ( l < r )
{
- retval = l < r ? -1 : +1; /* not a match after all */
+ while ( i <= r && retval == 0 )
+ {
+ if ( SvIV(*av_fetch((AV *)rsv,i,0)) != 0 )
+ retval = -1; /* not a match after all */
+ i++;
+ }
+ }
+ else
+ {
+ while ( i <= l && retval == 0 )
+ {
+ if ( SvIV(*av_fetch((AV *)lsv,i,0)) != 0 )
+ retval = +1; /* not a match after all */
+ i++;
+ }
}
}
return retval;
projects / p5sagit/p5-mst-13.2.git / commitdiff