1use strict; 2use warnings; 3# vim:ts=8:sw=2:et:sta:sts=2 4 5use Test::More 0.82; 6use Data::Dumper; 7use Module::Metadata; 8 9use lib 't/lib'; 10use GeneratePackage; 11 12my $undef; 13 14# parse various module $VERSION lines 15# format: { 16# name => test name 17# code => code snippet (string) 18# vers => expected version object (in stringified form), 19# } 20my @modules = ( 21{ 22 vers => $undef, 23 all_versions => {}, 24 name => 'no $VERSION line', 25 code => <<'---', 26package Simple; 27--- 28}, 29{ 30 vers => $undef, 31 all_versions => {}, 32 name => 'undefined $VERSION', 33 code => <<'---', 34package Simple; 35our $VERSION; 36--- 37}, 38{ 39 vers => '1.23', 40 all_versions => { Simple => '1.23' }, 41 name => 'declared & defined on same line with "our"', 42 code => <<'---', 43package Simple; 44our $VERSION = '1.23'; 45--- 46}, 47{ 48 vers => '1.23', 49 all_versions => { Simple => '1.23' }, 50 name => 'declared & defined on separate lines with "our"', 51 code => <<'---', 52package Simple; 53our $VERSION; 54$VERSION = '1.23'; 55--- 56}, 57{ 58 name => 'commented & defined on same line', 59 code => <<'---', 60package Simple; 61our $VERSION = '1.23'; # our $VERSION = '4.56'; 62--- 63 vers => '1.23', 64 all_versions => { Simple => '1.23' }, 65}, 66{ 67 name => 'commented & defined on separate lines', 68 code => <<'---', 69package Simple; 70# our $VERSION = '4.56'; 71our $VERSION = '1.23'; 72--- 73 vers =>'1.23', 74 all_versions => { Simple => '1.23' }, 75}, 76{ 77 name => 'use vars', 78 code => <<'---', 79package Simple; 80use vars qw( $VERSION ); 81$VERSION = '1.23'; 82--- 83 vers => '1.23', 84 all_versions => { Simple => '1.23' }, 85}, 86{ 87 name => 'choose the right default package based on package/file name', 88 code => <<'---', 89package Simple::_private; 90$VERSION = '0'; 91package Simple; 92$VERSION = '1.23'; # this should be chosen for version 93--- 94 vers => '1.23', 95 all_versions => { 'Simple' => '1.23', 'Simple::_private' => '0' }, 96}, 97{ 98 name => 'just read the first $VERSION line', 99 code => <<'---', 100package Simple; 101$VERSION = '1.23'; # we should see this line 102$VERSION = eval $VERSION; # and ignore this one 103--- 104 vers => '1.23', 105 all_versions => { Simple => '1.23' }, 106}, 107{ 108 name => 'just read the first $VERSION line in reopened package (1)', 109 code => <<'---', 110package Simple; 111$VERSION = '1.23'; 112package Error::Simple; 113$VERSION = '2.34'; 114package Simple; 115--- 116 vers => '1.23', 117 all_versions => { 'Error::Simple' => '2.34', Simple => '1.23' }, 118}, 119{ 120 name => 'just read the first $VERSION line in reopened package (2)', 121 code => <<'---', 122package Simple; 123package Error::Simple; 124$VERSION = '2.34'; 125package Simple; 126$VERSION = '1.23'; 127--- 128 vers => '1.23', 129 all_versions => { 'Error::Simple' => '2.34', Simple => '1.23' }, 130}, 131{ 132 name => 'mentions another module\'s $VERSION', 133 code => <<'---', 134package Simple; 135$VERSION = '1.23'; 136if ( $Other::VERSION ) { 137 # whatever 138} 139--- 140 vers => '1.23', 141 all_versions => { Simple => '1.23' }, 142}, 143{ 144 name => 'mentions another module\'s $VERSION in a different package', 145 code => <<'---', 146package Simple; 147$VERSION = '1.23'; 148package Simple2; 149if ( $Simple::VERSION ) { 150 # whatever 151} 152--- 153 vers => '1.23', 154 all_versions => { Simple => '1.23' }, 155}, 156{ 157 name => '$VERSION checked only in assignments, not regexp ops', 158 code => <<'---', 159package Simple; 160$VERSION = '1.23'; 161if ( $VERSION =~ /1\.23/ ) { 162 # whatever 163} 164--- 165 vers => '1.23', 166 all_versions => { Simple => '1.23' }, 167}, 168{ 169 name => '$VERSION checked only in assignments, not relational ops (1)', 170 code => <<'---', 171package Simple; 172$VERSION = '1.23'; 173if ( $VERSION == 3.45 ) { 174 # whatever 175} 176--- 177 vers => '1.23', 178 all_versions => { Simple => '1.23' }, 179}, 180{ 181 name => '$VERSION checked only in assignments, not relational ops (2)', 182 code => <<'---', 183package Simple; 184$VERSION = '1.23'; 185package Simple2; 186if ( $Simple::VERSION == 3.45 ) { 187 # whatever 188} 189--- 190 vers => '1.23', 191 all_versions => { Simple => '1.23' }, 192}, 193{ 194 name => 'Fully qualified $VERSION declared in package', 195 code => <<'---', 196package Simple; 197$Simple::VERSION = 1.23; 198--- 199 vers => '1.23', 200 all_versions => { Simple => '1.23' }, 201}, 202{ 203 name => 'Differentiate fully qualified $VERSION in a package', 204 code => <<'---', 205package Simple; 206$Simple2::VERSION = '999'; 207$Simple::VERSION = 1.23; 208--- 209 vers => '1.23', 210 all_versions => { Simple => '1.23', Simple2 => '999' }, 211}, 212{ 213 name => 'Differentiate fully qualified $VERSION and unqualified', 214 code => <<'---', 215package Simple; 216$Simple2::VERSION = '999'; 217$VERSION = 1.23; 218--- 219 vers => '1.23', 220 all_versions => { Simple => '1.23', Simple2 => '999' }, 221}, 222{ 223 name => 'Differentiate fully qualified $VERSION and unqualified, other order', 224 code => <<'---', 225package Simple; 226$VERSION = 1.23; 227$Simple2::VERSION = '999'; 228--- 229 vers => '1.23', 230 all_versions => { Simple => '1.23', Simple2 => '999' }, 231}, 232{ 233 name => '$VERSION declared as package variable from within "main" package', 234 code => <<'---', 235$Simple::VERSION = '1.23'; 236{ 237 package Simple; 238 $x = $y, $cats = $dogs; 239} 240--- 241 vers => '1.23', 242 all_versions => { Simple => '1.23' }, 243}, 244{ 245 name => '$VERSION wrapped in parens - space inside', 246 code => <<'---', 247package Simple; 248( $VERSION ) = '1.23'; 249--- 250 '1.23' => <<'---', # $VERSION wrapped in parens - no space inside 251package Simple; 252($VERSION) = '1.23'; 253--- 254 vers => '1.23', 255 all_versions => { Simple => '1.23' }, 256}, 257{ 258 name => '$VERSION follows a spurious "package" in a quoted construct', 259 code => <<'---', 260package Simple; 261__PACKAGE__->mk_accessors(qw( 262 program socket proc 263 package filename line codeline subroutine finished)); 264 265our $VERSION = "1.23"; 266--- 267 vers => '1.23', 268 all_versions => { Simple => '1.23' }, 269}, 270{ 271 name => '$VERSION using version.pm', 272 code => <<'---', 273 package Simple; 274 use version; our $VERSION = version->new('1.23'); 275--- 276 vers => '1.23', 277 all_versions => { Simple => '1.23' }, 278}, 279{ 280 name => '$VERSION using version.pm and qv()', 281 code => <<'---', 282 package Simple; 283 use version; our $VERSION = qv('1.230'); 284--- 285 vers => 'v1.230', 286 all_versions => { Simple => 'v1.230' }, 287}, 288{ 289 name => 'underscore version with an eval', 290 code => <<'---', 291 package Simple; 292 $VERSION = '1.23_01'; 293 $VERSION = eval $VERSION; 294--- 295 vers => '1.23_01', 296 all_versions => { Simple => '1.23_01' }, 297}, 298{ 299 name => 'Two version assignments, no package', 300 code => <<'---', 301 $Simple::VERSION = '1.230'; 302 $Simple::VERSION = eval $Simple::VERSION; 303--- 304 vers => $undef, 305 all_versions => { Simple => '1.230' }, 306}, 307{ 308 name => 'Two version assignments, should ignore second one', 309 code => <<'---', 310package Simple; 311 $Simple::VERSION = '1.230'; 312 $Simple::VERSION = eval $Simple::VERSION; 313--- 314 vers => '1.230', 315 all_versions => { Simple => '1.230' }, 316}, 317{ 318 name => 'declared & defined on same line with "our"', 319 code => <<'---', 320package Simple; 321our $VERSION = '1.23_00_00'; 322--- 323 vers => '1.230000', 324 all_versions => { Simple => '1.230000' }, 325}, 326{ 327 name => 'package NAME VERSION', 328 code => <<'---', 329 package Simple 1.23; 330--- 331 vers => '1.23', 332 all_versions => { Simple => '1.23' }, 333}, 334{ 335 name => 'package NAME VERSION', 336 code => <<'---', 337 package Simple 1.23_01; 338--- 339 vers => '1.23_01', 340 all_versions => { Simple => '1.23_01' }, 341}, 342{ 343 name => 'package NAME VERSION', 344 code => <<'---', 345 package Simple v1.2.3; 346--- 347 vers => 'v1.2.3', 348 all_versions => { Simple => 'v1.2.3' }, 349}, 350{ 351 name => 'package NAME VERSION', 352 code => <<'---', 353 package Simple v1.2_3; 354--- 355 vers => 'v1.2_3', 356 all_versions => { Simple => 'v1.2_3' }, 357}, 358{ 359 name => 'trailing crud', 360 code => <<'---', 361 package Simple; 362 our $VERSION; 363 $VERSION = '1.23-alpha'; 364--- 365 vers => '1.23', 366 all_versions => { Simple => '1.23' }, 367}, 368{ 369 name => 'trailing crud', 370 code => <<'---', 371 package Simple; 372 our $VERSION; 373 $VERSION = '1.23b'; 374--- 375 vers => '1.23', 376 all_versions => { Simple => '1.23' }, 377}, 378{ 379 name => 'multi_underscore', 380 code => <<'---', 381 package Simple; 382 our $VERSION; 383 $VERSION = '1.2_3_4'; 384--- 385 vers => '1.234', 386 all_versions => { Simple => '1.234' }, 387}, 388{ 389 name => 'non-numeric', 390 code => <<'---', 391 package Simple; 392 our $VERSION; 393 $VERSION = 'onetwothree'; 394--- 395 vers => '0', 396 all_versions => { Simple => '0' }, 397}, 398{ 399 name => 'package NAME BLOCK, undef $VERSION', 400 code => <<'---', 401package Simple { 402 our $VERSION; 403} 404--- 405 vers => $undef, 406 all_versions => {}, 407}, 408{ 409 name => 'package NAME BLOCK, with $VERSION', 410 code => <<'---', 411package Simple { 412 our $VERSION = '1.23'; 413} 414--- 415 vers => '1.23', 416 all_versions => { Simple => '1.23' }, 417}, 418{ 419 name => 'package NAME VERSION BLOCK (1)', 420 code => <<'---', 421package Simple 1.23 { 422 1; 423} 424--- 425 vers => '1.23', 426 all_versions => { Simple => '1.23' }, 427}, 428{ 429 name => 'package NAME VERSION BLOCK (2)', 430 code => <<'---', 431package Simple v1.2.3_4 { 432 1; 433} 434--- 435 vers => 'v1.2.3_4', 436 all_versions => { Simple => 'v1.2.3_4' }, 437}, 438{ 439 name => 'set from separately-initialised variable, two lines', 440 code => <<'---', 441package Simple; 442 our $CVSVERSION = '$Revision: 1.7 $'; 443 our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/); 444} 445--- 446 vers => '0', 447 all_versions => { Simple => '0' }, 448}, 449{ 450 name => 'our + bare v-string', 451 code => <<'---', 452package Simple; 453our $VERSION = v2.2.102.2; 454--- 455 vers => 'v2.2.102.2', 456 all_versions => { Simple => 'v2.2.102.2' }, 457}, 458{ 459 name => 'our + dev release', 460 code => <<'---', 461package Simple; 462our $VERSION = "0.0.9_1"; 463--- 464 vers => '0.0.9_1', 465 all_versions => { Simple => '0.0.9_1' }, 466}, 467{ 468 name => 'our + crazy string and substitution code', 469 code => <<'---', 470package Simple; 471our $VERSION = '1.12.B55J2qn'; our $WTF = $VERSION; $WTF =~ s/^\d+\.\d+\.//; # attempts to rationalize $WTF go here. 472--- 473 vers => '1.12', 474 all_versions => { Simple => '1.12' }, 475}, 476{ 477 name => 'our in braces, as in Dist::Zilla::Plugin::PkgVersion with use_our = 1', 478 code => <<'---', 479package Simple; 480{ our $VERSION = '1.12'; } 481--- 482 vers => '1.12', 483 all_versions => { Simple => '1.12' }, 484}, 485{ 486 name => 'calculated version - from Acme-Pi-3.14', 487 code => <<'---', 488package Simple; 489my $version = atan2(1,1) * 4; $Simple::VERSION = "$version"; 4901; 491--- 492 vers => sub { defined $_[0] and $_[0] =~ /^3\.14159/ }, 493 all_versions => sub { ref $_[0] eq 'HASH' 494 and keys %{$_[0]} == 1 495 and (keys%{$_[0]})[0] eq 'Simple' 496 and (values %{$_[0]})[0] =~ /^3\.14159/ 497 }, 498}, 499{ 500 name => 'set from separately-initialised variable, one line', 501 code => <<'---', 502package Simple; 503 my $CVSVERSION = '$Revision: 1.7 $'; our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/); 504} 505--- 506 vers => '1.7', 507 all_versions => { Simple => '1.7' }, 508}, 509{ 510 name => 'from Lingua-StopWords-0.09/devel/gen_modules.plx', 511 code => <<'---', 512package Foo; 513our $VERSION = $Bar::VERSION; 514--- 515 vers => $undef, 516 all_versions => { Foo => '0' }, 517}, 518{ 519 name => 'from XML-XSH2-2.1.17/lib/XML/XSH2/Parser.pm', 520 code => <<'---', 521our $VERSION = # Hide from PAUSE 522 '1.967009'; 523$VERSION = eval $VERSION; 524--- 525 vers => $undef, 526 all_versions => { main => '0' }, 527}, 528{ 529 name => 'from MBARBON/Module-Info-0.30.tar.gz', 530 code => <<'---', 531package Simple; 532$VERSION = eval 'use version; 1' ? 'version'->new('0.30') : '0.30'; 533--- 534 vers => '0.30', 535 all_versions => { Simple => '0.30' }, 536}, 537{ 538 name => '$VERSION inside BEGIN block', 539 code => <<'---', 540package Simple; 541 BEGIN { $VERSION = '1.23' } 542} 543--- 544 vers => '1.23', 545 all_versions => { Simple => '1.23' }, 546 TODO_scalar => 'apply fix from ExtUtils-MakeMaker PR#135', 547 TODO_all_versions => 'apply fix from ExtUtils-MakeMaker PR#135', 548}, 549{ 550 name => 'our $VERSION inside BEGIN block', 551 code => <<'---', 552 '1.23' => <<'---', # our + BEGIN 553package Simple; 554 BEGIN { our $VERSION = '1.23' } 555} 556--- 557 vers => '1.23', 558 all_versions => { Simple => '1.23' }, 559 TODO_scalar => 'apply fix from ExtUtils-MakeMaker PR#135', 560 TODO_all_versions => 'apply fix from ExtUtils-MakeMaker PR#135', 561}, 562{ 563 name => 'no assumption of primary version merely if a package\'s $VERSION is referenced', 564 code => <<'---', 565package Simple; 566$Foo::Bar::VERSION = '1.23'; 567--- 568 vers => undef, 569 all_versions => { 'Foo::Bar' => '1.23' }, 570}, 571{ 572 name => 'no package statement; bare $VERSION', 573 code => <<'---', 574$VERSION = '1.23'; 575--- 576 vers => undef, 577 all_versions => { '____caller' => '1.23' }, 578 TODO_all_versions => 'FIXME! RT#74741', 579}, 580{ 581 name => 'no package statement; bare $VERSION with our', 582 code => <<'---', 583our $VERSION = '1.23'; 584--- 585 vers => undef, 586 all_versions => { '____caller' => '1.23' }, 587 TODO_all_versions => 'FIXME! RT#74741', 588}, 589{ 590 name => 'no package statement; fully-qualified $VERSION for main', 591 code => <<'---', 592$::VERSION = '1.23'; 593--- 594 vers => undef, 595 all_versions => { 'main' => '1.23' }, 596}, 597{ 598 name => 'no package statement; fully-qualified $VERSION for other package', 599 code => <<'---', 600$Foo::Bar::VERSION = '1.23'; 601--- 602 vers => undef, 603 all_versions => { 'Foo::Bar' => '1.23' }, 604}, 605); 606 607my $test_num = 0; 608 609my $tmpdir = GeneratePackage::tmpdir(); 610 611# iterate through @modules 612foreach my $test_case (@modules) { 613 note '-------'; 614 note $test_case->{name}; 615 my $code = $test_case->{code}; 616 my $expected_version = $test_case->{vers}; 617 618 SKIP: { 619 skip( "No our() support until perl 5.6", (defined $expected_version ? 3 : 2) ) 620 if $] < 5.006 && $code =~ /\bour\b/; 621 skip( "No package NAME VERSION support until perl 5.11.1", (defined $expected_version ? 3 : 2) ) 622 if $] < 5.011001 && $code =~ /package\s+[\w\:\']+\s+v?[0-9._]+/; 623 624 my $warnings = ''; 625 local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; 626 627 my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catdir($tmpdir, "Simple${test_num}"), 'Simple.pm', $code)); 628 629 # whenever we drop support for 5.6, we can do this: 630 # open my $fh, '<', \(encode('UTF-8', $code, Encode::FB_CROAK)) 631 # or die "cannot open handle to code string: $!"; 632 # my $pm_info = Module::Metadata->new_from_handle($fh, 'lib/Simple.pm'); 633 634 my $errs; 635 my $got = $pm_info->version; 636 637 # note that in Test::More 0.94 and earlier, is() stringifies first before comparing; 638 # from 0.95_01 and later, it just lets the objects figure out how to handle 'eq' 639 # We want to ensure we preserve the original, as long as it's legal, so we 640 # explicitly check the stringified form. 641 { 642 local $TODO = $test_case->{TODO_got_version}; 643 isa_ok($got, 'version') if defined $expected_version; 644 } 645 646 if (ref($expected_version) eq 'CODE') { 647 local $TODO = $test_case->{TODO_code_sub}; 648 ok( 649 $expected_version->($got), 650 "case '$test_case->{name}': module version passes match sub" 651 ) 652 or $errs++; 653 } 654 else { 655 local $TODO = $test_case->{TODO_scalar}; 656 is( 657 (defined $got ? "$got" : $got), 658 $expected_version, 659 "case '$test_case->{name}': correct module version (" 660 . (defined $expected_version? "'$expected_version'" : 'undef') 661 . ')' 662 ) 663 or $errs++; 664 } 665 666 if (exists $test_case->{all_versions}) { 667 local $TODO = $test_case->{TODO_all_versions}; 668 if (ref($expected_version) eq 'CODE') { 669 ok( 670 $test_case->{all_versions}->($pm_info->{versions}), 671 "case '$test_case->{name}': all extracted versions passes match sub" 672 ); 673 } 674 else { 675 is_deeply( 676 $pm_info->{versions}, 677 $test_case->{all_versions}, 678 'correctly found all $VERSIONs', 679 ); 680 } 681 } 682 683 is( $warnings, '', "case '$test_case->{name}': no warnings from parsing" ) or $errs++; 684 diag 'extracted versions: ', explain({ got => $pm_info->{versions}, module_contents => $code }) if !$ENV{PERL_CORE} && $errs; 685 } 686} 687continue { 688 ++$test_num; 689} 690 691done_testing; 692