path: root/cpan/Module-Metadata/t/extract-version.t

use strict;
use warnings;
# vim:ts=8:sw=2:et:sta:sts=2

use Test::More 0.88;
use Module::Metadata;

use lib 't/lib';
use GeneratePackage;

my $undef;

# parse various module $VERSION lines
# format: {
#   name => test name
#   code => code snippet (string)
#   vers => expected version object (in stringified form),
# }
my @modules = (
{
  vers => $undef,
  all_versions => {},
  name => 'no $VERSION line',
  code => <<'---',
package Simple;
---
},
{
  vers => $undef,
  all_versions => {},
  name => 'undefined $VERSION',
  code => <<'---',
package Simple;
our $VERSION;
---
},
{
  vers => '1.23',
  all_versions => { Simple => '1.23' },
  name => 'declared & defined on same line with "our"',
  code => <<'---',
package Simple;
our $VERSION = '1.23';
---
},
{
  vers => '1.23',
  all_versions => { Simple => '1.23' },
  name => 'declared & defined on separate lines with "our"',
  code => <<'---',
package Simple;
our $VERSION;
$VERSION = '1.23';
---
},
{
  name => 'commented & defined on same line',
  code => <<'---',
package Simple;
our $VERSION = '1.23'; # our $VERSION = '4.56';
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'commented & defined on separate lines',
  code => <<'---',
package Simple;
# our $VERSION = '4.56';
our $VERSION = '1.23';
---
  vers =>'1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'use vars',
  code => <<'---',
package Simple;
use vars qw( $VERSION );
$VERSION = '1.23';
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'choose the right default package based on package/file name',
  code => <<'---',
package Simple::_private;
$VERSION = '0';
package Simple;
$VERSION = '1.23'; # this should be chosen for version
---
  vers => '1.23',
  all_versions => { 'Simple' => '1.23', 'Simple::_private' => '0' },
},
{
  name => 'just read the first $VERSION line',
  code => <<'---',
package Simple;
$VERSION = '1.23'; # we should see this line
$VERSION = eval $VERSION; # and ignore this one
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'just read the first $VERSION line in reopened package (1)',
  code => <<'---',
package Simple;
$VERSION = '1.23';
package Error::Simple;
$VERSION = '2.34';
package Simple;
---
  vers => '1.23',
  all_versions => { 'Error::Simple' => '2.34', Simple => '1.23' },
},
{
  name => 'just read the first $VERSION line in reopened package (2)',
  code => <<'---',
package Simple;
package Error::Simple;
$VERSION = '2.34';
package Simple;
$VERSION = '1.23';
---
  vers => '1.23',
  all_versions => { 'Error::Simple' => '2.34', Simple => '1.23' },
},
{
  name => 'mentions another module\'s $VERSION',
  code => <<'---',
package Simple;
$VERSION = '1.23';
if ( $Other::VERSION ) {
    # whatever
}
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'mentions another module\'s $VERSION in a different package',
  code => <<'---',
package Simple;
$VERSION = '1.23';
package Simple2;
if ( $Simple::VERSION ) {
    # whatever
}
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => '$VERSION checked only in assignments, not regexp ops',
  code => <<'---',
package Simple;
$VERSION = '1.23';
if ( $VERSION =~ /1\.23/ ) {
    # whatever
}
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => '$VERSION checked only in assignments, not relational ops (1)',
  code => <<'---',
package Simple;
$VERSION = '1.23';
if ( $VERSION == 3.45 ) {
    # whatever
}
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => '$VERSION checked only in assignments, not relational ops (2)',
  code => <<'---',
package Simple;
$VERSION = '1.23';
package Simple2;
if ( $Simple::VERSION == 3.45 ) {
    # whatever
}
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'Fully qualified $VERSION declared in package',
  code => <<'---',
package Simple;
$Simple::VERSION = 1.23;
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'Differentiate fully qualified $VERSION in a package',
  code => <<'---',
package Simple;
$Simple2::VERSION = '999';
$Simple::VERSION = 1.23;
---
  vers => '1.23',
  all_versions => { Simple => '1.23', Simple2 => '999' },
},
{
  name => 'Differentiate fully qualified $VERSION and unqualified',
  code => <<'---',
package Simple;
$Simple2::VERSION = '999';
$VERSION = 1.23;
---
  vers => '1.23',
  all_versions => { Simple => '1.23', Simple2 => '999' },
},
{
  name => 'Differentiate fully qualified $VERSION and unqualified, other order',
  code => <<'---',
package Simple;
$VERSION = 1.23;
$Simple2::VERSION = '999';
---
  vers => '1.23',
  all_versions => { Simple => '1.23', Simple2 => '999' },
},
{
  name => '$VERSION declared as package variable from within "main" package',
  code => <<'---',
$Simple::VERSION = '1.23';
{
  package Simple;
  $x = $y, $cats = $dogs;
}
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => '$VERSION wrapped in parens - space inside',
  code => <<'---',
package Simple;
( $VERSION ) = '1.23';
---
  '1.23' => <<'---', # $VERSION wrapped in parens - no space inside
package Simple;
($VERSION) = '1.23';
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => '$VERSION follows a spurious "package" in a quoted construct',
  code => <<'---',
package Simple;
__PACKAGE__->mk_accessors(qw(
    program socket proc
    package filename line codeline subroutine finished));

our $VERSION = "1.23";
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => '$VERSION using version.pm',
  code => <<'---',
  package Simple;
  use version; our $VERSION = version->new('1.23');
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => '$VERSION using version.pm and qv()',
  code => <<'---',
  package Simple;
  use version; our $VERSION = qv('1.230');
---
  vers => 'v1.230',
  all_versions => { Simple => 'v1.230' },
},
{
  name => 'underscore version with an eval',
  code => <<'---',
  package Simple;
  $VERSION = '1.23_01';
  $VERSION = eval $VERSION;
---
  vers => '1.23_01',
  all_versions => { Simple => '1.23_01' },
},
{
  name => 'Two version assignments, no package',
  code => <<'---',
  $Simple::VERSION = '1.230';
  $Simple::VERSION = eval $Simple::VERSION;
---
  vers => $undef,
  all_versions => { Simple => '1.230' },
},
{
  name => 'Two version assignments, should ignore second one',
  code => <<'---',
package Simple;
  $Simple::VERSION = '1.230';
  $Simple::VERSION = eval $Simple::VERSION;
---
  vers => '1.230',
  all_versions => { Simple => '1.230' },
},
{
  name => 'declared & defined on same line with "our"',
  code => <<'---',
package Simple;
our $VERSION = '1.23_00_00';
---
  vers => '1.230000',
  all_versions => { Simple => '1.230000' },
},
{
  name => 'package NAME VERSION',
  code => <<'---',
  package Simple 1.23;
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'package NAME VERSION',
  code => <<'---',
  package Simple 1.23_01;
---
  vers => '1.23_01',
  all_versions => { Simple => '1.23_01' },
},
{
  name => 'package NAME VERSION',
  code => <<'---',
  package Simple v1.2.3;
---
  vers => 'v1.2.3',
  all_versions => { Simple => 'v1.2.3' },
},
{
  name => 'package NAME VERSION',
  code => <<'---',
  package Simple v1.2_3;
---
  vers => 'v1.2_3',
  all_versions => { Simple => 'v1.2_3' },
},
{
  name => 'trailing crud',
  code => <<'---',
  package Simple;
  our $VERSION;
  $VERSION = '1.23-alpha';
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'trailing crud',
  code => <<'---',
  package Simple;
  our $VERSION;
  $VERSION = '1.23b';
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'multi_underscore',
  code => <<'---',
  package Simple;
  our $VERSION;
  $VERSION = '1.2_3_4';
---
  vers => '1.234',
  all_versions => { Simple => '1.234' },
},
{
  name => 'non-numeric',
  code => <<'---',
  package Simple;
  our $VERSION;
  $VERSION = 'onetwothree';
---
  vers => '0',
  all_versions => { Simple => '0' },
},
{
  name => 'package NAME BLOCK, undef $VERSION',
  code => <<'---',
package Simple {
  our $VERSION;
}
---
  vers => $undef,
  all_versions => {},
},
{
  name => 'package NAME BLOCK, with $VERSION',
  code => <<'---',
package Simple {
  our $VERSION = '1.23';
}
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'package NAME VERSION BLOCK (1)',
  code => <<'---',
package Simple 1.23 {
  1;
}
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
},
{
  name => 'package NAME VERSION BLOCK (2)',
  code => <<'---',
package Simple v1.2.3_4 {
  1;
}
---
  vers => 'v1.2.3_4',
  all_versions => { Simple => 'v1.2.3_4' },
},
{
  name => 'set from separately-initialised variable, two lines',
  code => <<'---',
package Simple;
  our $CVSVERSION   = '$Revision: 1.7 $';
  our ($VERSION)    = ($CVSVERSION =~ /(\d+\.\d+)/);
}
---
  vers => '0',
  all_versions => { Simple => '0' },
},
{
  name => 'our + bare v-string',
  code => <<'---',
package Simple;
our $VERSION     = v2.2.102.2;
---
  vers => 'v2.2.102.2',
  all_versions => { Simple => 'v2.2.102.2' },
},
{
  name => 'our + dev release',
  code => <<'---',
package Simple;
our $VERSION = "0.0.9_1";
---
  vers => '0.0.9_1',
  all_versions => { Simple => '0.0.9_1' },
},
{
  name => 'our + crazy string and substitution code',
  code => <<'---',
package Simple;
our $VERSION     = '1.12.B55J2qn'; our $WTF = $VERSION; $WTF =~ s/^\d+\.\d+\.//; # attempts to rationalize $WTF go here.
---
  vers => '1.12',
  all_versions => { Simple => '1.12' },
},
{
  name => 'our in braces, as in Dist::Zilla::Plugin::PkgVersion with use_our = 1',
  code => <<'---',
package Simple;
{ our $VERSION = '1.12'; }
---
  vers => '1.12',
  all_versions => { Simple => '1.12' },
},
{
  name => 'calculated version - from Acme-Pi-3.14',
  code => <<'---',
package Simple;
my $version = atan2(1,1) * 4; $Simple::VERSION = "$version";
1;
---
  vers => sub { defined $_[0] and $_[0] =~ /^3\.14159/ },
  all_versions => sub { ref $_[0] eq 'HASH'
                        and keys %{$_[0]} == 1
                        and (keys%{$_[0]})[0] eq 'Simple'
                        and (values %{$_[0]})[0] =~ /^3\.14159/
                      },
},
{
  name => 'set from separately-initialised variable, one line',
  code => <<'---',
package Simple;
  my $CVSVERSION   = '$Revision: 1.7 $'; our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/);
}
---
  vers => '1.7',
  all_versions => { Simple => '1.7' },
},
{
  name => 'from Lingua-StopWords-0.09/devel/gen_modules.plx',
  code => <<'---',
package Foo;
our $VERSION = $Bar::VERSION;
---
  vers => $undef,
  all_versions => { Foo => '0' },
},
{
  name => 'from XML-XSH2-2.1.17/lib/XML/XSH2/Parser.pm',
  code => <<'---',
our $VERSION = # Hide from PAUSE
     '1.967009';
$VERSION = eval $VERSION;
---
  vers => $undef,
  all_versions => { main => '0' },
},
{
  name => 'from MBARBON/Module-Info-0.30.tar.gz',
  code => <<'---',
package Simple;
$VERSION = eval 'use version; 1' ? 'version'->new('0.30') : '0.30';
---
  vers => '0.30',
  all_versions => { Simple => '0.30' },
},
{
  name => '$VERSION inside BEGIN block',
  code => <<'---',
package Simple;
  BEGIN { $VERSION = '1.23' }
}
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
  TODO_scalar => 'apply fix from ExtUtils-MakeMaker PR#135',
  TODO_all_versions => 'apply fix from ExtUtils-MakeMaker PR#135',
},
{
  name => 'our $VERSION inside BEGIN block',
  code => <<'---',
  '1.23' => <<'---', # our + BEGIN
package Simple;
  BEGIN { our $VERSION = '1.23' }
}
---
  vers => '1.23',
  all_versions => { Simple => '1.23' },
  TODO_scalar => 'apply fix from ExtUtils-MakeMaker PR#135',
  TODO_all_versions => 'apply fix from ExtUtils-MakeMaker PR#135',
},
{
  name => 'no assumption of primary version merely if a package\'s $VERSION is referenced',
  code => <<'---',
package Simple;
$Foo::Bar::VERSION = '1.23';
---
  vers => undef,
  all_versions => { 'Foo::Bar' => '1.23' },
},
{
  name => 'no package statement; bare $VERSION',
  code => <<'---',
$VERSION = '1.23';
---
  vers => undef,
  all_versions => { '____caller' => '1.23' },
  TODO_all_versions => 'FIXME! RT#74741',
},
{
  name => 'no package statement; bare $VERSION with our',
  code => <<'---',
our $VERSION = '1.23';
---
  vers => undef,
  all_versions => { '____caller' => '1.23' },
  TODO_all_versions => 'FIXME! RT#74741',
},
{
  name => 'no package statement; fully-qualified $VERSION for main',
  code => <<'---',
$::VERSION = '1.23';
---
  vers => undef,
  all_versions => { 'main' => '1.23' },
},
{
  name => 'no package statement; fully-qualified $VERSION for other package',
  code => <<'---',
$Foo::Bar::VERSION = '1.23';
---
  vers => undef,
  all_versions => { 'Foo::Bar' => '1.23' },
},
{
  name => 'package statement that does not quite match the filename',
  filename => 'Simple.pm',
  code => <<'---',
package ThisIsNotSimple;
our $VERSION = '1.23';
---
  vers => $undef,
  all_versions => { 'ThisIsNotSimple' => '1.23' },
},
);

my $test_num = 0;

my $tmpdir = GeneratePackage::tmpdir();

# iterate through @modules
foreach my $test_case (@modules) {
  note '-------';
  note $test_case->{name};
  my $code = $test_case->{code};
  my $expected_version = $test_case->{vers};

  SKIP: {
    skip( "No our() support until perl 5.6", (defined $expected_version ? 3 : 2) )
        if "$]" < 5.006 && $code =~ /\bour\b/;
    skip( "No package NAME VERSION support until perl 5.11.1", (defined $expected_version ? 3 : 2) )
        if "$]" < 5.011001 && $code =~ /package\s+[\w\:\']+\s+v?[0-9._]+/;

    my $warnings = '';
    local $SIG{__WARN__} = sub { $warnings .= $_ for @_ };

    my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catfile($tmpdir, "Simple${test_num}"), 'Simple.pm', $code));

    # whenever we drop support for 5.6, we can do this:
    # open my $fh, '<', \(encode('UTF-8', $code, Encode::FB_CROAK))
    #     or die "cannot open handle to code string: $!";
    # my $pm_info = Module::Metadata->new_from_handle($fh, 'lib/Simple.pm');

    my $errs;
    my $got = $pm_info->version;

    # note that in Test::More 0.94 and earlier, is() stringifies first before comparing;
    # from 0.95_01 and later, it just lets the objects figure out how to handle 'eq'
    # We want to ensure we preserve the original, as long as it's legal, so we
    # explicitly check the stringified form.
    {
      local $TODO = !defined($got) && ($test_case->{TODO_code_sub} || $test_case->{TODO_scalar}) ? 1 : undef;
      isa_ok($got, 'version') or $errs++ if defined $expected_version;
    }

    if (ref($expected_version) eq 'CODE') {
      local $TODO = $test_case->{TODO_code_sub};
      ok(
        $expected_version->($got),
        "case '$test_case->{name}': module version passes match sub"
      )
      or $errs++;
    }
    else {
      local $TODO = $test_case->{TODO_scalar};
      is(
        (defined $got ? "$got" : $got),
        $expected_version,
        "case '$test_case->{name}': correct module version ("
          . (defined $expected_version? "'$expected_version'" : 'undef')
          . ')'
      )
      or $errs++;
    }

    if (exists $test_case->{all_versions}) {
      local $TODO = $test_case->{TODO_all_versions};
      if (ref($expected_version) eq 'CODE') {
        ok(
          $test_case->{all_versions}->($pm_info->{versions}),
          "case '$test_case->{name}': all extracted versions passes match sub"
        ) or $errs++;
      }
      else {
        is_deeply(
          $pm_info->{versions},
          $test_case->{all_versions},
          'correctly found all $VERSIONs',
        ) or $errs++;
      }
    }

    is( $warnings, '', "case '$test_case->{name}': no warnings from parsing" ) or $errs++;
    diag 'parsed module: ', explain($pm_info) if $errs and not $ENV{PERL_CORE}
      and ($ENV{AUTHOR_TESTING} or $ENV{AUTOMATED_TESTING});
  }
}
continue {
  ++$test_num;
}

done_testing;