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