1b39c5158Smillert#!/usr/bin/perl -w 2b39c5158Smillert 3*eac174f2Safresh1use strict; 4*eac174f2Safresh1use warnings; 5*eac174f2Safresh1 6b39c5158SmillertBEGIN { 7b39c5158Smillert unshift @INC, 't/lib'; 8b39c5158Smillert} 9b39c5158Smillertchdir 't'; 10b39c5158Smillert 11b39c5158Smillertuse Test::More; 12b39c5158Smillertuse ExtUtils::MakeMaker; 13e9ce3842Safresh1use File::Temp qw[tempfile]; 14b39c5158Smillert 15b39c5158Smillertmy $Has_Version = eval 'require version; "version"->import; 1'; 16b39c5158Smillert 17e5157e49Safresh1# "undef" - means we expect "undef", undef - eval should be never called for this string 18b39c5158Smillertmy %versions = (q[$VERSION = '1.00'] => '1.00', 19b39c5158Smillert q[*VERSION = \'1.01'] => '1.01', 2051a0b77bSmillert q[($VERSION) = q$Revision: 32208 $ =~ /(\d+)/g;] => 32208, 21b39c5158Smillert q[$FOO::VERSION = '1.10';] => '1.10', 22b39c5158Smillert q[*FOO::VERSION = \'1.11';] => '1.11', 23b39c5158Smillert '$VERSION = 0.02' => 0.02, 24b39c5158Smillert '$VERSION = 0.0' => 0.0, 25*eac174f2Safresh1 '$VERSION = -1.0' => 'undef', 26b39c5158Smillert '$VERSION = undef' => 'undef', 27e5157e49Safresh1 '$wibble = 1.0' => undef, 28b39c5158Smillert q[my $VERSION = '1.01'] => 'undef', 299f11ffb7Safresh1 q[local $VERSION = '1.02'] => 'undef', 30b39c5158Smillert q[local $FOO::VERSION = '1.30'] => 'undef', 31*eac174f2Safresh1 q[if( $Foo::VERSION >= 3.00 ) {]=> undef, 32b39c5158Smillert q[our $VERSION = '1.23';] => '1.23', 33e5157e49Safresh1 q[$CGI::VERSION='3.63'] => '3.63', 34e5157e49Safresh1 q[$VERSION = "1.627"; # ==> ALSO update the version in the pod text below!] => '1.627', 35b8851fccSafresh1 q[BEGIN { our $VERSION = '1.23' }] => '1.23', 36b39c5158Smillert 37e5157e49Safresh1 '$Something::VERSION == 1.0' => undef, 38e5157e49Safresh1 '$Something::VERSION <= 1.0' => undef, 39e5157e49Safresh1 '$Something::VERSION >= 1.0' => undef, 40e5157e49Safresh1 '$Something::VERSION != 1.0' => undef, 41e5157e49Safresh1 'my $meta_coder = ($JSON::XS::VERSION >= 1.4) ?' => undef, 42b39c5158Smillert 43b39c5158Smillert qq[\$Something::VERSION == 1.0\n\$VERSION = 2.3\n] => '2.3', 44b39c5158Smillert qq[\$Something::VERSION == 1.0\n\$VERSION = 2.3\n\$VERSION = 4.5\n] => '2.3', 45b39c5158Smillert 4651a0b77bSmillert '$VERSION = sprintf("%d.%03d", q$Revision: 3.74 $ =~ /(\d+)\.(\d+)/);' => '3.074', 4751a0b77bSmillert '$VERSION = substr(q$Revision: 2.8 $, 10) + 2 . "";' => '4.8', 48e5157e49Safresh1 q[our $VERSION = do { my @r = ( q$Revision: 2.7 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r };] => '2.07', # Fucking seriously? 49e5157e49Safresh1 'elsif ( $Something::VERSION >= 1.99 )' => undef, 50b39c5158Smillert ); 51b39c5158Smillert 52b39c5158Smillertif( $Has_Version ) { 53b39c5158Smillert $versions{q[use version; $VERSION = qv("1.2.3");]} = qv("1.2.3"); 54b39c5158Smillert $versions{q[$VERSION = qv("1.2.3")]} = qv("1.2.3"); 55e5157e49Safresh1 $versions{q[$VERSION = v1.2.3]} = 'v1.2.3'; 56b39c5158Smillert} 57b39c5158Smillert 5856d68f1eSafresh1if( "$]" >= 5.011001 ) { 59b39c5158Smillert $versions{'package Foo 1.23;' } = '1.23'; 60b39c5158Smillert $versions{'package Foo::Bar 1.23;' } = '1.23'; 61b39c5158Smillert $versions{'package Foo v1.2.3;' } = 'v1.2.3'; 62b39c5158Smillert $versions{'package Foo::Bar v1.2.3;' } = 'v1.2.3'; 63b39c5158Smillert $versions{' package Foo::Bar 1.23 ;' } = '1.23'; 64b39c5158Smillert $versions{"package Foo'Bar 1.23;" } = '1.23'; 65b39c5158Smillert $versions{'package Foo 1.230;' } = '1.230'; 66*eac174f2Safresh1 $versions{q["package Foo 1.23"]} = undef; 67*eac174f2Safresh1 $versions{q[our $VERSION = "1.00 / the fucking fuck";]} = 'undef'; 68b39c5158Smillert $versions{<<'END'} = '1.23'; 69b39c5158Smillertpackage Foo 1.23; 70b39c5158Smillertour $VERSION = 2.34; 71b39c5158SmillertEND 72b39c5158Smillert 73b39c5158Smillert $versions{<<'END'} = '2.34'; 74b39c5158Smillertour $VERSION = 2.34; 75b39c5158Smillertpackage Foo 1.23; 76b39c5158SmillertEND 77b39c5158Smillert 78b39c5158Smillert $versions{<<'END'} = '2.34'; 79b39c5158Smillertpackage Foo::100; 80b39c5158Smillertour $VERSION = 2.34; 81b39c5158SmillertEND 82b39c5158Smillert} 83b39c5158Smillert 8456d68f1eSafresh1if( "$]" >= 5.014 ) { 859f11ffb7Safresh1 $versions{'package Foo 1.23 { }' } = '1.23'; 869f11ffb7Safresh1 $versions{'package Foo::Bar 1.23 { }' } = '1.23'; 879f11ffb7Safresh1 $versions{'package Foo v1.2.3 { }' } = 'v1.2.3'; 889f11ffb7Safresh1 $versions{'package Foo::Bar v1.2.3 { }' } = 'v1.2.3'; 899f11ffb7Safresh1 $versions{' package Foo::Bar 1.23 { }' } = '1.23'; 909f11ffb7Safresh1 $versions{"package Foo'Bar 1.23 { }" } = '1.23'; 919f11ffb7Safresh1 $versions{'package Foo 1.230 { }' } = '1.230'; 929f11ffb7Safresh1 $versions{<<'END'} = '1.23'; 939f11ffb7Safresh1package Foo 1.23 { 949f11ffb7Safresh1our $VERSION = 2.34; 959f11ffb7Safresh1} 969f11ffb7Safresh1END 979f11ffb7Safresh1 989f11ffb7Safresh1 $versions{<<'END'} = '2.34'; 999f11ffb7Safresh1our $VERSION = 2.34; 1009f11ffb7Safresh1package Foo 1.23 { } 1019f11ffb7Safresh1END 1029f11ffb7Safresh1 1039f11ffb7Safresh1 $versions{<<'END'} = '2.34'; 1049f11ffb7Safresh1package Foo::100 { 1059f11ffb7Safresh1our $VERSION = 2.34; 1069f11ffb7Safresh1} 1079f11ffb7Safresh1END 1089f11ffb7Safresh1} 1099f11ffb7Safresh1 11056d68f1eSafresh1if ( "$]" < 5.012 ) { 111e5157e49Safresh1 delete $versions{'$VERSION = -1.0'}; 112e5157e49Safresh1} 113e5157e49Safresh1 114e5157e49Safresh1plan tests => (3 * keys %versions) + 4 + grep { !defined} (values %versions); 115b39c5158Smillert 116b39c5158Smillertfor my $code ( sort keys %versions ) { 117b39c5158Smillert my $expect = $versions{$code}; 118b39c5158Smillert (my $label = $code) =~ s/\n/\\n/g; 11948950c12Ssthen my $warnings = ""; 12048950c12Ssthen local $SIG{__WARN__} = sub { $warnings .= "@_\n"; }; 121e5157e49Safresh1 if (defined $expect) { 122b39c5158Smillert is( parse_version_string($code), $expect, $label ); 123e5157e49Safresh1 } else { 124e5157e49Safresh1 my $is_called = 0; 125e5157e49Safresh1 no warnings qw[redefine once]; 126e5157e49Safresh1 local *MM::get_version = sub { 127e5157e49Safresh1 $is_called = 1; 128e5157e49Safresh1 }; 129e5157e49Safresh1 ok !$is_called; 130e5157e49Safresh1 is( parse_version_string($code), 'undef', $label ); 131e5157e49Safresh1 } 13248950c12Ssthen is($warnings, '', "$label does not cause warnings"); 133b39c5158Smillert} 134b39c5158Smillert 135b39c5158Smillert 136b39c5158Smillertsub parse_version_string { 137b39c5158Smillert my $code = shift; 138b39c5158Smillert 139e9ce3842Safresh1 my ($fh,$file) = tempfile( DIR => '.', UNLINK => 1 ); 140e9ce3842Safresh1 print $fh "$code\n"; 141e9ce3842Safresh1 close $fh; 142b39c5158Smillert 143b39c5158Smillert $_ = 'foo'; 144e9ce3842Safresh1 my $version = MM->parse_version( $file ); 145b39c5158Smillert is( $_, 'foo', '$_ not leaked by parse_version' ); 146b39c5158Smillert 147b39c5158Smillert return $version; 148b39c5158Smillert} 149b39c5158Smillert 150b39c5158Smillert 151b39c5158Smillert# This is a specific test to see if a version subroutine in the $VERSION 152b39c5158Smillert# declaration confuses later calls to the version class. 153b39c5158Smillert# [rt.cpan.org 30747] 154b39c5158SmillertSKIP: { 155b39c5158Smillert skip "need version.pm", 4 unless $Has_Version; 156b39c5158Smillert is parse_version_string(q[ $VERSION = '1.00'; sub version { $VERSION } ]), 157b39c5158Smillert '1.00', "eval 'sub version {...} in version string"; 158b39c5158Smillert is parse_version_string(q[ use version; $VERSION = version->new("1.2.3") ]), 159b39c5158Smillert qv("1.2.3"), "version.pm not confused by version sub"; 160b39c5158Smillert} 161