This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Sync up tests with upstream version.pm
[perl5.git] / lib / version.t
index bee9078..0284643 100644 (file)
@@ -328,6 +328,11 @@ sub BaseTests {
     $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 ++" );
@@ -474,6 +479,20 @@ SKIP: {
            '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
@@ -624,7 +643,6 @@ SKIP: {
        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');
 
@@ -700,6 +718,32 @@ EOF
        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; 
@@ -722,6 +766,22 @@ SKIP: {
        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;