#! /usr/local/perl -w
*Verbose
= \
$Test::Harness::Verbose
;
if
(
$Test::More::VERSION
< 0.48) {
local
$^W;
*main::use_ok
=
sub
($;@) {
my
(
$pkg
,
$req
,
@args
) =
@_
;
eval
"use $pkg $req "
.
join
(
' '
,
@args
);
is ${
"$pkg\::VERSION"
},
$req
,
'Had to manually use version'
;
};
}
sub
BaseTests {
my
(
$CLASS
,
$method
,
$qv_declare
) =
@_
;
my
$warning
;
local
$SIG
{__WARN__} =
sub
{
$warning
=
$_
[0] };
diag
"tests with bare numbers"
if
$Verbose
;
$version
=
$CLASS
->
$method
(5.005_03);
is (
"$version"
,
"5.00503"
,
'5.005_03 eq 5.00503'
);
$version
=
$CLASS
->
$method
(1.23);
is (
"$version"
,
"1.23"
,
'1.23 eq "1.23"'
);
diag
"tests with quoted numbers"
if
$Verbose
;
$version
=
$CLASS
->
$method
(
"5.005_03"
);
is (
"$version"
,
"5.005_03"
,
'"5.005_03" eq "5.005_03"'
);
$version
=
$CLASS
->
$method
(
"v1.23"
);
is (
"$version"
,
"v1.23"
,
'"v1.23" eq "v1.23"'
);
diag
"tests with stringify"
if
$Verbose
;
$version
=
$CLASS
->
$method
(
"5.005"
);
is (
"$version"
,
"5.005"
,
'5.005 eq "5.005"'
);
$version
=
$CLASS
->
$method
(
"5.006.001"
);
is (
"$version"
,
"5.006.001"
,
'5.006.001 eq v5.6.1'
);
unlike (
$warning
,
qr/v-string without leading 'v' deprecated/
,
'No leading v'
);
$version
=
$CLASS
->
$method
(
"v1.2.3_4"
);
is (
"$version"
,
"v1.2.3_4"
,
'alpha version 1.2.3_4 eq v1.2.3_4'
);
diag
"test illegal formats"
if
$Verbose
;
eval
{
my
$version
=
$CLASS
->
$method
(
"1.2_3_4"
)};
like($@,
qr/multiple underscores/
,
"Invalid version format (multiple underscores)"
);
eval
{
my
$version
=
$CLASS
->
$method
(
"1.2_3.4"
)};
like($@,
qr/underscores before decimal/
,
"Invalid version format (underscores before decimal)"
);
eval
{
my
$version
=
$CLASS
->
$method
(
"1_2"
)};
like($@,
qr/alpha without decimal/
,
"Invalid version format (alpha without decimal)"
);
eval
{
$version
=
$CLASS
->
$method
(
"1.2b3"
)};
like($@,
qr/non-numeric data/
,
"Invalid version format (non-numeric data)"
);
{
eval
{
$version
=
$CLASS
->
$method
(
"99 and 44/100 pure"
)};
like($@,
qr/non-numeric data/
,
"Invalid version format (non-numeric data)"
);
eval
{
$version
=
$CLASS
->
$method
(
"something"
)};
like($@,
qr/non-numeric data/
,
"Invalid version format (non-numeric data)"
);
$version
=
$CLASS
->
$method
(
"1.2.3"
);
ok (
$version
,
'boolean'
);
isa_ok (
$version
,
$CLASS
);
diag
"tests with self"
if
$Verbose
;
is (
$version
<=>
$version
, 0,
'$version <=> $version == 0'
);
ok (
$version
==
$version
,
'$version == $version'
);
$version
=
$CLASS
->
$method
(
"5.006.001"
);
$new_version
=
"5.8.0"
;
diag
"numeric tests with non-objects"
if
$Verbose
;
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'
);
$new_version
=
$CLASS
->
$method
(
$new_version
);
diag
"numeric tests with objects"
if
$Verbose
;
ok (
$version
<
$new_version
,
'$version < $new_version'
);
ok (
$new_version
>
$version
,
'$new_version > $version'
);
ok (
$version
!=
$new_version
,
'$version != $new_version'
);
diag
"numeric tests with numbers"
if
$Verbose
;
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'
);
diag
"Tests with extended decimal versions"
if
$Verbose
;
$version
=
$CLASS
->
$method
(1.002003);
ok (
$version
==
"1.2.3"
,
'$version == "1.2.3"'
);
ok (
$version
->numify == 1.002003,
'$version->numify == 1.002003'
);
$version
=
$CLASS
->
$method
(
"2002.09.30.1"
);
ok (
$version
==
"2002.9.30.1"
,
'$version == 2002.9.30.1'
);
ok (
$version
->numify == 2002.009030001,
'$version->numify == 2002.009030001'
);
$version
=
$CLASS
->
$method
(
"1.2.3"
);
$new_version
=
"1.2.3_4"
;
diag
"numeric tests with alpha-style non-objects"
if
$Verbose
;
ok (
$version
<
$new_version
,
'$version < $new_version'
);
ok (
$new_version
>
$version
,
'$new_version > $version'
);
ok (
$version
!=
$new_version
,
'$version != $new_version'
);
$version
=
$CLASS
->
$method
(
"1.2.4"
);
diag
"numeric tests with alpha-style non-objects"
if
$Verbose
;
ok (
$version
>
$new_version
,
'$version > $new_version'
);
ok (
$new_version
<
$version
,
'$new_version < $version'
);
ok (
$version
!=
$new_version
,
'$version != $new_version'
);
$version
=
$CLASS
->
$method
(
"1.2.3"
);
$new_version
=
$CLASS
->
$method
(
"1.2.3_4"
);
diag
"tests with alpha-style objects"
if
$Verbose
;
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
->
$method
(
"1.2.4"
);
diag
"tests with alpha-style objects"
if
$Verbose
;
ok (
$version
>
$new_version
,
'$version > $new_version'
);
ok (
$new_version
<
$version
,
'$new_version < $version'
);
ok (
$version
!=
$new_version
,
'$version != $new_version'
);
$version
=
$CLASS
->
$method
(
"1.2.3.4"
);
$new_version
=
$CLASS
->
$method
(
"1.2.3_4"
);
diag
"tests with alpha-style objects with same subversion"
if
$Verbose
;
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"
if
$Verbose
;
$version
=
$CLASS
->
$method
(
"v1.2.3"
);
$new_version
=
$CLASS
->
$method
(
"1.2.3.0"
);
ok (
$version
==
$new_version
,
'$version == $new_version'
);
$new_version
=
$CLASS
->
$method
(
"1.2.3_0"
);
ok (
$version
==
$new_version
,
'$version == $new_version'
);
$new_version
=
$CLASS
->
$method
(
"1.2.3.1"
);
ok (
$version
<
$new_version
,
'$version < $new_version'
);
$new_version
=
$CLASS
->
$method
(
"1.2.3_1"
);
ok (
$version
<
$new_version
,
'$version < $new_version'
);
$new_version
=
$CLASS
->
$method
(
"1.1.999"
);
ok (
$version
>
$new_version
,
'$version > $new_version'
);
diag
"forbidden operations"
if
$Verbose
;
ok ( !
eval
{ ++
$version
},
"noop ++"
);
ok ( !
eval
{ --
$version
},
"noop --"
);
ok ( !
eval
{
$version
/1 },
"noop /"
);
ok ( !
eval
{
$version
*3 },
"noop *"
);
ok ( !
eval
{
abs
(
$version
) },
"noop abs"
);
SKIP: {
skip
"version require'd instead of use'd, cannot test $qv_declare"
, 3
unless
defined
$qv_declare
;
diag
"testing $qv_declare"
if
$Verbose
;
$version
=
$CLASS
->
$qv_declare
(
"1.2"
);
is (
"$version"
,
"v1.2"
,
$qv_declare
.
'("1.2") == "1.2.0"'
);
$version
=
$CLASS
->
$qv_declare
(1.2);
is (
"$version"
,
"v1.2"
,
$qv_declare
.
'(1.2) == "1.2.0"'
);
isa_ok(
$CLASS
->
$qv_declare
(
'5.008'
),
$CLASS
);
}
diag
"create new from existing version"
if
$Verbose
;
ok (
eval
{
$new_version
=
$CLASS
->
$method
(
$version
)},
"new from existing object"
);
ok (
$new_version
==
$version
,
"class->$method($version) identical"
);
$new_version
=
$version
->
$method
(0);
isa_ok (
$new_version
,
$CLASS
);
is (
$new_version
,
"0"
,
"version->$method() doesn't clone"
);
$new_version
=
$version
->
$method
(
"1.2.3"
);
is (
$new_version
,
"1.2.3"
,
'$version->$method("1.2.3") works too'
);
diag
"testing CVS Revision"
if
$Verbose
;
$version
= new
$CLASS
qw$Revision: 1.2$
;
ok (
$version
==
"1.2.0"
,
'qw$Revision: 1.2$ == 1.2.0'
);
$version
= new
$CLASS
qw$Revision: 1.2.3.4$
;
ok (
$version
==
"1.2.3.4"
,
'qw$Revision: 1.2.3.4$ == 1.2.3.4'
);
diag
"testing CPAN-style versions"
if
$Verbose
;
$version
=
$CLASS
->
$method
(
"1.23_01"
);
is (
"$version"
,
"1.23_01"
,
"CPAN-style alpha version"
);
ok (
$version
> 1.23,
"1.23_01 > 1.23"
);
ok (
$version
< 1.24,
"1.23_01 < 1.24"
);
diag
"Replacement UNIVERSAL::VERSION tests"
if
$Verbose
;
my
$error_regex
= $] < 5.006
?
'version \d required'
:
'does not define \$t.{7}::VERSION'
;
{
my
(
$fh
,
$filename
) = tempfile(
'tXXXXXXX'
,
SUFFIX
=>
'.pm'
,
UNLINK
=> 1);
(
my
$package
= basename(
$filename
)) =~ s/\.pm$//;
print
$fh
"package $package;\n\$$package\::VERSION=0.58;\n1;\n"
;
close
$fh
;
$version
= 0.58;
eval
"use lib '.'; use $package $version"
;
unlike($@,
qr/$package version $version/
,
'Replacement eval works with exact version'
);
$new_version
=
$package
->VERSION;
cmp_ok(
$new_version
,
'=='
,
$version
,
"Called as class method"
);
eval
"print Completely::Unknown::Module->VERSION"
;
if
( $] < 5.008 ) {
unlike($@,
qr/$error_regex/
,
"Don't freak if the module doesn't even exist"
);
}
else
{
unlike($@,
qr/defines neither package nor VERSION/
,
"Don't freak if the module doesn't even exist"
);
}
$version
+= 0.01;
eval
"use lib '.'; use $package $version"
;
like($@,
qr/$package version $version/
,
'Replacement eval works with incremented version'
);
$version
=~ s/0+$//;
chop
(
$version
);
eval
"use lib '.'; use $package $version"
;
unlike($@,
qr/$package version $version/
,
'Replacement eval works with single digit'
);
$version
+= 0.1;
eval
"use lib '.'; use $package $version"
;
like($@,
qr/$package version $version/
,
'Replacement eval works with incremented digit'
);
unlink
$filename
;
}
{
my
(
$fh
,
$filename
) = tempfile(
'tXXXXXXX'
,
SUFFIX
=>
'.pm'
,
UNLINK
=> 1);
(
my
$package
= basename(
$filename
)) =~ s/\.pm$//;
print
$fh
"1;\n"
;
close
$fh
;
eval
"use lib '.'; use $package 3;"
;
if
( $] < 5.008 ) {
like($@,
qr/$error_regex/
,
'Replacement handles modules without package or VERSION'
);
}
else
{
like($@,
qr/defines neither package nor VERSION/
,
'Replacement handles modules without package or VERSION'
);
}
eval
"use lib '.'; use $package; \$version = $package->VERSION"
;
unlike ($@,
qr/$error_regex/
,
'Replacement handles modules without package or VERSION'
);
ok (!
defined
(
$version
),
"Called as class method"
);
unlink
$filename
;
}
{
my
(
$fh
,
$filename
) = tempfile(
'tXXXXXXX'
,
SUFFIX
=>
'.pm'
,
UNLINK
=> 1);
(
my
$package
= basename(
$filename
)) =~ s/\.pm$//;
print
$fh
"package $package;\n#look ma no VERSION\n1;\n"
;
close
$fh
;
eval
"use lib '.'; use $package 3;"
;
like ($@,
qr/$error_regex/
,
'Replacement handles modules without VERSION'
);
eval
"use lib '.'; use $package; print $package->VERSION"
;
unlike ($@,
qr/$error_regex/
,
'Replacement handles modules without VERSION'
);
unlink
$filename
;
}
{
my
(
$fh
,
$filename
) = tempfile(
'tXXXXXXX'
,
SUFFIX
=>
'.pm'
,
UNLINK
=> 1);
(
my
$package
= basename(
$filename
)) =~ s/\.pm$//;
print
$fh
"package $package;\n\@VERSION = ();\n1;\n"
;
close
$fh
;
eval
"use lib '.'; use $package 3;"
;
like ($@,
qr/$error_regex/
,
'Replacement handles modules without VERSION'
);
eval
"use lib '.'; use $package; print $package->VERSION"
;
unlike ($@,
qr/$error_regex/
,
'Replacement handles modules without VERSION'
);
unlink
$filename
;
}
SKIP: {
skip
'Cannot test bare v-strings with Perl < 5.6.0'
, 4
if
$] < 5.006_000;
diag
"Tests with v-strings"
if
$Verbose
;
$version
=
$CLASS
->
$method
(1.2.3);
ok(
"$version"
eq
"v1.2.3"
,
'"$version" eq 1.2.3'
);
$version
=
$CLASS
->
$method
(1.0.0);
$new_version
=
$CLASS
->
$method
(1);
ok(
$version
==
$new_version
,
'$version == $new_version'
);
skip
"version require'd instead of use'd, cannot test declare"
, 1
unless
defined
$qv_declare
;
$version
=
&$qv_declare
(1.2.3);
ok(
"$version"
eq
"v1.2.3"
,
'v-string initialized $qv_declare()'
);
}
SKIP: {
skip
'Cannot test bare alpha v-strings with Perl < 5.8.1'
, 2
if
$] lt 5.008_001;
diag
"Tests with bare alpha v-strings"
if
$Verbose
;
$version
=
$CLASS
->
$method
(v1.2.3_4);
is(
$version
,
"v1.2.3_4"
,
'"$version" eq "v1.2.3_4"'
);
$version
=
$CLASS
->
$method
(
eval
"v1.2.3_4"
);
is(
$version
,
"v1.2.3_4"
,
'"$version" eq "v1.2.3_4" (from eval)'
);
}
diag
"Tests with real-world (malformed) data"
if
$Verbose
;
$version
=
$CLASS
->
$method
(
"1"
);
ok(
$version
->numify eq
"1.000"
,
"trailing zeros preserved"
);
$version
=
$CLASS
->
$method
(
"1.0"
);
ok(
$version
->numify eq
"1.000"
,
"trailing zeros preserved"
);
$version
=
$CLASS
->
$method
(
"1.0.0"
);
ok(
$version
->numify eq
"1.000000"
,
"trailing zeros preserved"
);
$version
=
$CLASS
->
$method
(
"1.0.0.0"
);
ok(
$version
->numify eq
"1.000000000"
,
"trailing zeros preserved"
);
$version
=
$CLASS
->
$method
(
".7"
);
ok(
$version
->numify eq
"0.700"
,
"leading zero inferred"
);
$version
=
$CLASS
->
$method
(
" 1.7"
);
ok(
$version
->numify eq
"1.700"
,
"leading space ignored"
);
ok(
"$version"
ne
'undef'
,
"Undef version comparison #1"
);
ok(
"$version"
ne
undef
,
"Undef version comparison #2"
);
$version
=
$CLASS
->
$method
(
'undef'
);
unlike(
$warning
,
qr/^Version string 'undef' contains invalid data/
,
"Version string 'undef'"
);
$version
=
$CLASS
->
$method
(
undef
);
like(
$warning
,
qr/^Use of uninitialized value/
,
"Version string 'undef'"
);
ok(
$version
==
'undef'
,
"Undef version comparison #3"
);
ok(
$version
==
undef
,
"Undef version comparison #4"
);
eval
"\$version = \$CLASS->$method()"
;
unlike($@,
qr/^Bizarre copy of CODE/
,
"No initializer at all"
);
ok(
$version
==
'undef'
,
"Undef version comparison #5"
);
ok(
$version
==
undef
,
"Undef version comparison #6"
);
$version
=
$CLASS
->
$method
(0.000001);
unlike(
$warning
,
qr/^Version string '1e-06' contains invalid data/
,
"Very small version objects"
);
}
SKIP: {
my
$warning
;
local
$SIG
{__WARN__} =
sub
{
$warning
=
$_
[0] };
my
(
$fh
,
$filename
) = tempfile(
'tXXXXXXX'
,
SUFFIX
=>
'.pm'
,
UNLINK
=> 1);
(
my
$package
= basename(
$filename
)) =~ s/\.pm$//;
print
$fh
<<"EOF";
package $package;
use $CLASS; \$VERSION = ${CLASS}->new('0.0.4');
1;
EOF
close
$fh
;
eval
"use lib '.'; use $package 0.000008;"
;
like ($@,
qr/^$package version 0.000008 required/
,
"Make sure very small versions don't freak"
);
eval
"use lib '.'; use $package 1;"
;
like ($@,
qr/^$package version 1 required/
,
"Comparing vs. version with no decimal"
);
eval
"use lib '.'; use $package 1.;"
;
like ($@,
qr/^$package version 1 required/
,
"Comparing vs. version with decimal only"
);
if
( $] < 5.006_000 ) {
skip
'Cannot "use" extended versions with Perl < 5.6.0'
, 3;
}
eval
"use lib '.'; use $package v0.0.8;"
;
my
$regex
=
"^$package version v0.0.8 required"
;
like ($@,
qr/$regex/
,
"Make sure very small versions don't freak"
);
$regex
=~ s/8/4/;
eval
"use lib '.'; use $package v0.0.4;"
;
unlike($@,
qr/$regex/
,
'Succeed - required == VERSION'
);
cmp_ok (
$package
->VERSION,
'eq'
,
'0.0.4'
,
'No undef warnings'
);
unlink
$filename
;
}
SKIP: {
skip
'Cannot test "use base qw(version)" when require is used'
, 3
unless
defined
$qv_declare
;
my
(
$fh
,
$filename
) = tempfile(
'tXXXXXXX'
,
SUFFIX
=>
'.pm'
,
UNLINK
=> 1);
(
my
$package
= basename(
$filename
)) =~ s/\.pm$//;
print
$fh
<<"EOF";
package $package;
use base qw(version);
1;
EOF
close
$fh
;
undef
*{
"main\::$qv_declare"
};
ok(!
defined
(&{
"main\::$qv_declare"
}),
"make sure we cleared $qv_declare() properly"
);
eval
"use lib '.'; use $package qw/declare qv/;"
;
ok(
defined
(&{
"main\::$qv_declare"
}),
"make sure we exported $qv_declare() properly"
);
isa_ok(
&$qv_declare
(1.2),
$package
);
unlink
$filename
;
}
SKIP: {
if
( $] < 5.006_000 ) {
skip
'Cannot "use" extended versions with Perl < 5.6.0'
, 3;
}
my
(
$fh
,
$filename
) = tempfile(
'tXXXXXXX'
,
SUFFIX
=>
'.pm'
,
UNLINK
=> 1);
(
my
$package
= basename(
$filename
)) =~ s/\.pm$//;
print
$fh
<<"EOF";
package $package;
\$VERSION = 1.0;
1;
EOF
close
$fh
;
eval
"use lib '.'; use $package 1.001;"
;
like ($@,
qr/^$package version 1.001 required/
,
"User typed numeric so we error with numeric"
);
eval
"use lib '.'; use $package v1.1.0;"
;
like ($@,
qr/^$package version v1.1.0 required/
,
"User typed extended so we error with extended"
);
unlink
$filename
;
}
SKIP: {
my
$warning
;
local
$SIG
{__WARN__} =
sub
{
$warning
=
$_
[0] };
$DB::single
= 1;
my
$v
=
eval
{
$CLASS
->
$method
(
'1,7'
) };
my
$ver
= 1.23;
my
$orig_loc
= setlocale( LC_ALL );
my
$loc
;
while
(<DATA>) {
chomp
;
$loc
= setlocale( LC_ALL,
$_
);
last
if
localeconv()->{decimal_point} eq
','
;
}
skip
'Cannot test locale handling without a comma locale'
, 4
unless
(
$loc
and (
$ver
eq
'1,23'
) );
diag (
"Testing locale handling with $loc"
)
if
$Verbose
;
$v
=
$CLASS
->
$method
(
$ver
);
unlike(
$warning
,
qr/Version string '1,23' contains invalid data/
,
"Process locale-dependent floating point"
);
is (
$v
,
"1.23"
,
"Locale doesn't apply to version objects"
);
ok (
$v
==
$ver
,
"Comparison to locale floating point"
);
setlocale( LC_ALL,
$orig_loc
);
skip
'Cannot test RT#46921 with Perl < 5.008'
, 1
if
($] < 5.008);
skip
'Cannot test RT#46921 with pure Perl module'
, 1
if
exists
$INC
{
'version/vpp.pm'
};
my
(
$fh
,
$filename
) = tempfile(
'tXXXXXXX'
,
SUFFIX
=>
'.pm'
,
UNLINK
=> 1);
(
my
$package
= basename(
$filename
)) =~ s/\.pm$//;
print
$fh
<<"EOF";
package $package;
use POSIX qw(locale_h);
\$^W = 1;
use $CLASS;
setlocale (LC_ALL, '$loc');
use $CLASS ;
eval "use Socket 1.7";
setlocale( LC_ALL, '$orig_loc');
1;
EOF
close
$fh
;
eval
"use lib '.'; use $package;"
;
unlike(
$warning
,
qr"Version string '1,7' contains invalid data"
,
'Handle locale action-at-a-distance'
);
}
eval
'my $v = $CLASS->$method("1._1");'
;
unlike($@,
qr/^Invalid version format \(alpha with zero width\)/
,
"Invalid version format 1._1"
);
{
my
$warning
;
local
$SIG
{__WARN__} =
sub
{
$warning
=
$_
[0] };
eval
'my $v = $CLASS->$method(~0);'
;
unlike($@,
qr/Integer overflow in version/
,
"Too large version"
);
like(
$warning
,
qr/Integer overflow in version/
,
"Too large version"
);
}
{
my
$v1
=
$CLASS
->
$method
(
"v0.1_1"
);
(
my
$alpha1
= Dumper(
$v1
)) =~ s/.+
'alpha'
=> ([^,]+),.+/$1/ms;
my
$v2
=
$CLASS
->
$method
(
$v1
);
(
my
$alpha2
= Dumper(
$v2
)) =~ s/.+
'alpha'
=> ([^,]+),.+/$1/ms;
is
$alpha2
,
$alpha1
,
"Don't fall for Data::Dumper's tricks"
;
}
{
my
$badv
=
bless
{
version
=> [1,2,3] },
"version"
;
is
$badv
,
'1.002003'
,
"Deal with badly serialized versions from YAML"
;
my
$badv2
=
bless
{
qv
=> 1,
version
=> [1,2,3] },
"version"
;
is
$badv2
,
'v1.2.3'
,
"Deal with badly serialized versions from YAML "
;
}
SKIP: {
if
( $] < 5.006_000 ) {
skip
'No v-string support at all < 5.6.0'
, 2;
}
my
$v
=
$CLASS
->
$method
(
"420"
);
is
"$v"
,
"420"
,
'Correctly guesses this is not a v-string'
;
$v
=
$CLASS
->
$method
(4.2.0);
is
"$v"
,
'v4.2.0'
,
'Correctly guess that this is a v-string'
;
}
SKIP: {
if
( $] < 5.006_000 ) {
skip
'No v-string support at all < 5.6.0'
, 4;
}
ok
$CLASS
->
$method
(1.2.3) <
$CLASS
->
$method
(1.2.3.1),
'Compare 3 and 4 digit v-strings'
;
ok
$CLASS
->
$method
(v1.2.3) <
$CLASS
->
$method
(v1.2.3.1),
'Compare 3 and 4 digit v-strings, leaving v'
;
ok
$CLASS
->
$method
(
"1.2.3"
) <
$CLASS
->
$method
(
"1.2.3.1"
),
'Compare 3 and 4 digit v-strings, quoted'
;
ok
$CLASS
->
$method
(
"v1.2.3"
) <
$CLASS
->
$method
(
"v1.2.3.1"
),
'Compare 3 and 4 digit v-strings, quoted leading v'
;
}
}
1;