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 => 'trailing crud', 359 code => <<'---', 360 package Simple; 361 our $VERSION; 362 $VERSION = '1.23-alpha'; 363--- 364 vers => '1.23', 365 all_versions => { Simple => '1.23' }, 366}, 367{ 368 name => 'trailing crud', 369 code => <<'---', 370 package Simple; 371 our $VERSION; 372 $VERSION = '1.23b'; 373--- 374 vers => '1.23', 375 all_versions => { Simple => '1.23' }, 376}, 377{ 378 name => 'multi_underscore', 379 code => <<'---', 380 package Simple; 381 our $VERSION; 382 $VERSION = '1.2_3_4'; 383--- 384 vers => '1.234', 385 all_versions => { Simple => '1.234' }, 386}, 387{ 388 name => 'non-numeric', 389 code => <<'---', 390 package Simple; 391 our $VERSION; 392 $VERSION = 'onetwothree'; 393--- 394 vers => '0', 395 all_versions => { Simple => '0' }, 396}, 397{ 398 name => 'package NAME BLOCK, undef $VERSION', 399 code => <<'---', 400package Simple { 401 our $VERSION; 402} 403--- 404 vers => $undef, 405 all_versions => {}, 406}, 407{ 408 name => 'package NAME BLOCK, with $VERSION', 409 code => <<'---', 410package Simple { 411 our $VERSION = '1.23'; 412} 413--- 414 vers => '1.23', 415 all_versions => { Simple => '1.23' }, 416}, 417{ 418 name => 'package NAME VERSION BLOCK (1)', 419 code => <<'---', 420package Simple 1.23 { 421 1; 422} 423--- 424 vers => '1.23', 425 all_versions => { Simple => '1.23' }, 426}, 427{ 428 name => 'package NAME VERSION BLOCK (2)', 429 code => <<'---', 430package Simple v1.2.3_4 { 431 1; 432} 433--- 434 vers => 'v1.2.3_4', 435 all_versions => { Simple => 'v1.2.3_4' }, 436}, 437{ 438 name => 'set from separately-initialised variable, two lines', 439 code => <<'---', 440package Simple; 441 our $CVSVERSION = '$Revision: 1.7 $'; 442 our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/); 443} 444--- 445 vers => '0', 446 all_versions => { Simple => '0' }, 447}, 448{ 449 name => 'our + bare v-string', 450 code => <<'---', 451package Simple; 452our $VERSION = v2.2.102.2; 453--- 454 vers => 'v2.2.102.2', 455 all_versions => { Simple => 'v2.2.102.2' }, 456}, 457{ 458 name => 'our + dev release', 459 code => <<'---', 460package Simple; 461our $VERSION = "0.0.9_1"; 462--- 463 vers => '0.0.9_1', 464 all_versions => { Simple => '0.0.9_1' }, 465}, 466{ 467 name => 'our + crazy string and substitution code', 468 code => <<'---', 469package Simple; 470our $VERSION = '1.12.B55J2qn'; our $WTF = $VERSION; $WTF =~ s/^\d+\.\d+\.//; # attempts to rationalize $WTF go here. 471--- 472 vers => '1.12', 473 all_versions => { Simple => '1.12' }, 474}, 475{ 476 name => 'our in braces, as in Dist::Zilla::Plugin::PkgVersion with use_our = 1', 477 code => <<'---', 478package Simple; 479{ our $VERSION = '1.12'; } 480--- 481 vers => '1.12', 482 all_versions => { Simple => '1.12' }, 483}, 484{ 485 name => 'calculated version - from Acme-Pi-3.14', 486 code => <<'---', 487package Simple; 488my $version = atan2(1,1) * 4; $Simple::VERSION = "$version"; 4891; 490--- 491 vers => sub { defined $_[0] and $_[0] =~ /^3\.14159/ }, 492 all_versions => sub { ref $_[0] eq 'HASH' 493 and keys %{$_[0]} == 1 494 and (keys%{$_[0]})[0] eq 'Simple' 495 and (values %{$_[0]})[0] =~ /^3\.14159/ 496 }, 497}, 498{ 499 name => 'set from separately-initialised variable, one line', 500 code => <<'---', 501package Simple; 502 my $CVSVERSION = '$Revision: 1.7 $'; our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/); 503} 504--- 505 vers => '1.7', 506 all_versions => { Simple => '1.7' }, 507}, 508{ 509 name => 'from Lingua-StopWords-0.09/devel/gen_modules.plx', 510 code => <<'---', 511package Foo; 512our $VERSION = $Bar::VERSION; 513--- 514 vers => $undef, 515 all_versions => { Foo => '0' }, 516}, 517{ 518 name => 'from XML-XSH2-2.1.17/lib/XML/XSH2/Parser.pm', 519 code => <<'---', 520our $VERSION = # Hide from PAUSE 521 '1.967009'; 522$VERSION = eval $VERSION; 523--- 524 vers => $undef, 525 all_versions => { main => '0' }, 526}, 527{ 528 name => 'from MBARBON/Module-Info-0.30.tar.gz', 529 code => <<'---', 530package Simple; 531$VERSION = eval 'use version; 1' ? 'version'->new('0.30') : '0.30'; 532--- 533 vers => '0.30', 534 all_versions => { Simple => '0.30' }, 535}, 536{ 537 name => '$VERSION inside BEGIN block', 538 code => <<'---', 539package Simple; 540 BEGIN { $VERSION = '1.23' } 541} 542--- 543 vers => '1.23', 544 all_versions => { Simple => '1.23' }, 545 TODO_scalar => 'apply fix from ExtUtils-MakeMaker PR#135', 546 TODO_all_versions => 'apply fix from ExtUtils-MakeMaker PR#135', 547}, 548{ 549 name => 'our $VERSION inside BEGIN block', 550 code => <<'---', 551 '1.23' => <<'---', # our + BEGIN 552package Simple; 553 BEGIN { our $VERSION = '1.23' } 554} 555--- 556 vers => '1.23', 557 all_versions => { Simple => '1.23' }, 558 TODO_scalar => 'apply fix from ExtUtils-MakeMaker PR#135', 559 TODO_all_versions => 'apply fix from ExtUtils-MakeMaker PR#135', 560}, 561{ 562 name => 'no assumption of primary version merely if a package\'s $VERSION is referenced', 563 code => <<'---', 564package Simple; 565$Foo::Bar::VERSION = '1.23'; 566--- 567 vers => undef, 568 all_versions => { 'Foo::Bar' => '1.23' }, 569}, 570{ 571 name => 'no package statement; bare $VERSION', 572 code => <<'---', 573$VERSION = '1.23'; 574--- 575 vers => undef, 576 all_versions => { '____caller' => '1.23' }, 577 TODO_all_versions => 'FIXME! RT#74741', 578}, 579{ 580 name => 'no package statement; bare $VERSION with our', 581 code => <<'---', 582our $VERSION = '1.23'; 583--- 584 vers => undef, 585 all_versions => { '____caller' => '1.23' }, 586 TODO_all_versions => 'FIXME! RT#74741', 587}, 588{ 589 name => 'no package statement; fully-qualified $VERSION for main', 590 code => <<'---', 591$::VERSION = '1.23'; 592--- 593 vers => undef, 594 all_versions => { 'main' => '1.23' }, 595}, 596{ 597 name => 'no package statement; fully-qualified $VERSION for other package', 598 code => <<'---', 599$Foo::Bar::VERSION = '1.23'; 600--- 601 vers => undef, 602 all_versions => { 'Foo::Bar' => '1.23' }, 603}, 604{ 605 name => 'package statement that does not quite match the filename', 606 filename => 'Simple.pm', 607 code => <<'---', 608package ThisIsNotSimple; 609our $VERSION = '1.23'; 610--- 611 vers => $undef, 612 all_versions => { 'ThisIsNotSimple' => '1.23' }, 613}, 614); 615 616my $test_num = 0; 617 618my $tmpdir = GeneratePackage::tmpdir(); 619 620# iterate through @modules 621foreach my $test_case (@modules) { 622 note '-------'; 623 note $test_case->{name}; 624 my $code = $test_case->{code}; 625 my $expected_version = $test_case->{vers}; 626 627 SKIP: { 628 skip( "No our() support until perl 5.6", (defined $expected_version ? 3 : 2) ) 629 if "$]" < 5.006 && $code =~ /\bour\b/; 630 skip( "No package NAME VERSION support until perl 5.11.1", (defined $expected_version ? 3 : 2) ) 631 if "$]" < 5.011001 && $code =~ /package\s+[\w\:\']+\s+v?[0-9._]+/; 632 633 my $warnings = ''; 634 local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; 635 636 my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catfile($tmpdir, "Simple${test_num}"), 'Simple.pm', $code)); 637 638 # whenever we drop support for 5.6, we can do this: 639 # open my $fh, '<', \(encode('UTF-8', $code, Encode::FB_CROAK)) 640 # or die "cannot open handle to code string: $!"; 641 # my $pm_info = Module::Metadata->new_from_handle($fh, 'lib/Simple.pm'); 642 643 my $errs; 644 my $got = $pm_info->version; 645 646 # note that in Test::More 0.94 and earlier, is() stringifies first before comparing; 647 # from 0.95_01 and later, it just lets the objects figure out how to handle 'eq' 648 # We want to ensure we preserve the original, as long as it's legal, so we 649 # explicitly check the stringified form. 650 { 651 local $TODO = !defined($got) && ($test_case->{TODO_code_sub} || $test_case->{TODO_scalar}) ? 1 : undef; 652 isa_ok($got, 'version') or $errs++ if defined $expected_version; 653 } 654 655 if (ref($expected_version) eq 'CODE') { 656 local $TODO = $test_case->{TODO_code_sub}; 657 ok( 658 $expected_version->($got), 659 "case '$test_case->{name}': module version passes match sub" 660 ) 661 or $errs++; 662 } 663 else { 664 local $TODO = $test_case->{TODO_scalar}; 665 is( 666 (defined $got ? "$got" : $got), 667 $expected_version, 668 "case '$test_case->{name}': correct module version (" 669 . (defined $expected_version? "'$expected_version'" : 'undef') 670 . ')' 671 ) 672 or $errs++; 673 } 674 675 if (exists $test_case->{all_versions}) { 676 local $TODO = $test_case->{TODO_all_versions}; 677 if (ref($expected_version) eq 'CODE') { 678 ok( 679 $test_case->{all_versions}->($pm_info->{versions}), 680 "case '$test_case->{name}': all extracted versions passes match sub" 681 ) or $errs++; 682 } 683 else { 684 is_deeply( 685 $pm_info->{versions}, 686 $test_case->{all_versions}, 687 'correctly found all $VERSIONs', 688 ) or $errs++; 689 } 690 } 691 692 is( $warnings, '', "case '$test_case->{name}': no warnings from parsing" ) or $errs++; 693 diag 'parsed module: ', explain($pm_info) if $errs and not $ENV{PERL_CORE} 694 and ($ENV{AUTHOR_TESTING} or $ENV{AUTOMATED_TESTING}); 695 } 696} 697continue { 698 ++$test_num; 699} 700 701done_testing; 702