#! /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'
-
-#########################
use Test::More qw(no_plan);
use Data::Dumper;
BaseTests("version","parse", "qv");
BaseTests("version","parse", "declare");
-# dummy up a redundant call to satify David Wheeler
+# dummy up a redundant call to satisfy David Wheeler
local $SIG{__WARN__} = sub { die $_[0] };
eval 'use version;';
unlike ($@, qr/^Subroutine main::declare redefined/,
# test illegal formats
diag "test illegal formats" unless $ENV{PERL_CORE};
- eval {$version = $CLASS->$method("1.2_3_4")};
+ eval {my $version = $CLASS->$method("1.2_3_4")};
like($@, qr/multiple underscores/,
"Invalid version format (multiple underscores)");
- eval {$version = $CLASS->$method("1.2_3.4")};
+ eval {my $version = $CLASS->$method("1.2_3.4")};
like($@, qr/underscores before decimal/,
"Invalid version format (underscores before decimal)");
- eval {$version = $CLASS->$method("1_2")};
+ eval {my $version = $CLASS->$method("1_2")};
like($@, qr/alpha without decimal/,
"Invalid version format (alpha without decimal)");
like($@, qr/non-numeric data/,
"Invalid version format (non-numeric data)");
+ eval { $version = $CLASS->$method("-1.23")};
+ like($@, qr/negative version number/,
+ "Invalid version format (negative version number)");
+
# from here on out capture the warning and test independently
{
eval{$version = $CLASS->$method("99 and 44/100 pure")};
$new_version = $CLASS->$method("1.1.999");
ok ( $version > $new_version, '$version > $new_version' );
+ diag "test with version class names" unless $ENV{PERL_CORE};
+ $version = $CLASS->$method("v1.2.3");
+ eval { () = $version < $CLASS };
+ like $@, qr/^Invalid version format/, "error with $version < $CLASS";
+
# that which is not expressly permitted is forbidden
diag "forbidden operations" unless $ENV{PERL_CORE};
ok ( !eval { ++$version }, "noop ++" );
ok (eval {$new_version = $CLASS->$method($version)},
"new from existing object");
ok ($new_version == $version, "class->$method($version) identical");
- $new_version = $version->$method();
+ $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");
'Replacement handles modules without VERSION');
unlink $filename;
}
+SKIP: { # https://rt.perl.org/rt3/Ticket/Display.html?id=95544
+ skip "version require'd instead of use'd, cannot test UNIVERSAL::VERSION", 2
+ unless defined $qv_declare;
+ my ($fh, $filename) = tempfile('tXXXXXXX', SUFFIX => '.pm', UNLINK => 1);
+ (my $package = basename($filename)) =~ s/\.pm$//;
+ print $fh "package $package;\n\$VERSION = '3alpha';\n1;\n";
+ close $fh;
+ eval "use lib '.'; use $package; print $package->VERSION";
+ like ($@, qr/Invalid version format \(non-numeric data\)/,
+ 'Warn about bad \$VERSION');
+ eval "use lib '.'; use $package 1;";
+ like ($@, qr/Invalid version format \(non-numeric data\)/,
+ 'Warn about bad $VERSION');
+ }
SKIP: {
skip 'Cannot test bare v-strings with Perl < 5.6.0', 4
if $] < 5.006_000;
diag "Tests with v-strings" unless $ENV{PERL_CORE};
$version = $CLASS->$method(1.2.3);
- ok("$version" == "v1.2.3", '"$version" == 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" == "v1.2.3", 'v-string initialized $qv_declare()');
+ 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" unless $ENV{PERL_CORE};
+ $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" unless $ENV{PERL_CORE};
my $warning;
local $SIG{__WARN__} = sub { $warning = $_[0] };
-$DB::single = 1;
my $v = eval { $CLASS->$method('1,7') };
# is( $@, "", 'Directly test comma as decimal compliance');
my $badv2 = bless { qv => 1, version => [1,2,3] }, "version";
is $badv2, 'v1.2.3', "Deal with badly serialized versions from YAML ";
}
+
+ {
+ # https://rt.cpan.org/Public/Bug/Display.html?id=70950
+ # test indirect usage of version objects
+ my $sum = 0;
+ eval '$sum += $CLASS->$method("v2.0.0")';
+ like $@, qr/operation not supported with version object/,
+ 'No math operations with version objects';
+ # test direct usage of version objects
+ my $v = $CLASS->$method("v2.0.0");
+ eval '$v += 1';
+ like $@, qr/operation not supported with version object/,
+ 'No math operations with version objects';
+ }
+
+ {
+ # https://rt.cpan.org/Ticket/Display.html?id=72365
+ # https://rt.perl.org/rt3/Ticket/Display.html?id=102586
+ eval 'my $v = $CLASS->$method("version")';
+ like $@, qr/Invalid version format/,
+ 'The string "version" is not a version';
+ eval 'my $v = $CLASS->$method("ver510n")';
+ like $@, qr/Invalid version format/,
+ 'All strings starting with "v" are not versions';
+ }
+
+SKIP: {
+ if ( $] < 5.006_000 ) {
+ skip 'No v-string support at all < 5.6.0', 2;
+ }
+ # https://rt.cpan.org/Ticket/Display.html?id=49348
+ 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;
+ }
+ # https://rt.cpan.org/Ticket/Display.html?id=50347
+ # Check that the qv() implementation does not change
+
+ 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';
+ }
+
+ {
+ eval '$CLASS->$method("version")';
+ pass("no crash with ${CLASS}->${method}('version')");
+ {
+ package _102586;
+ sub TIESCALAR { bless [] }
+ sub FETCH { "version" }
+ sub STORE { }
+ my $v;
+ tie $v, __PACKAGE__;
+ $v = $CLASS->$method(1);
+ eval '$CLASS->$method($v)';
+ }
+ pass('no crash with version->new($tied) where $tied returns "version"');
+ }
}
1;
https://perl5.git.perl.org / perl5.git / blobdiff