diff options
author | Karen Etheridge <ether@cpan.org> | 2015-09-30 21:30:20 -0700 |
---|---|---|
committer | James E Keenan <jkeenan@cpan.org> | 2015-10-01 19:48:01 -0400 |
commit | 0fa1f7e4e66a455cab6ccf1f9c49f2373c1ced80 (patch) | |
tree | 01f6ccaab30a02ae50f13242ae4be46ba54273aa /cpan/Module-Metadata | |
parent | 4b89cb47a04366ffd503d523f2fcf2375cec0a8e (diff) | |
download | perl-0fa1f7e4e66a455cab6ccf1f9c49f2373c1ced80.tar.gz |
Upgrade Module-Metadata from 1.000027 to 1.000029-TRIAL
1.000029 2015-09-11 16:25:43Z (TRIAL RELEASE)
- fix missing "use" statement in refactored test helper (only affected older
perls, due to other module interactions)
1.000028 2015-09-11 04:24:39Z (TRIAL RELEASE)
- refactored and expanded test cases
- fixed a $VERSION extraction issue on perl 5.6.2 (RT#105978, PR#17)
- fix the detection of package Foo when $Foo::VERSION is set (RT#85961)
from
https://cpan.metacpan.org/authors/id/E/ET/ETHER/Module-Metadata-1.000029-TRIAL.tar.gz
distribution files omitted:
CONTRIBUTING
Changes
INSTALL
LICENSE
MANIFEST
META.json
META.yml
Makefile.PL
README
dist.ini
t/00-report-prereqs.dd
t/00-report-prereqs.t
weaver.ini
xt/author/00-compile.t
xt/author/compat_lc.t
xt/author/eol.t
xt/author/kwalitee.t
xt/author/mojibake.t
xt/author/no-tabs.t
xt/release/changes_has_content.t
xt/release/cpan-changes.t
xt/release/distmeta.t
xt/release/minimum-version.t
xt/release/pod-coverage.t
xt/release/pod-no404s.t
xt/release/pod-syntax.t
xt/release/portability.t
Diffstat (limited to 'cpan/Module-Metadata')
-rw-r--r-- | cpan/Module-Metadata/lib/Module/Metadata.pm | 300 | ||||
-rw-r--r-- | cpan/Module-Metadata/t/extract-package.t | 146 | ||||
-rw-r--r-- | cpan/Module-Metadata/t/extract-version.t | 683 | ||||
-rw-r--r-- | cpan/Module-Metadata/t/lib/GeneratePackage.pm | 38 | ||||
-rw-r--r-- | cpan/Module-Metadata/t/metadata.t | 366 |
5 files changed, 1083 insertions, 450 deletions
diff --git a/cpan/Module-Metadata/lib/Module/Metadata.pm b/cpan/Module-Metadata/lib/Module/Metadata.pm index 2fa75c1b4a..3fa404ea23 100644 --- a/cpan/Module-Metadata/lib/Module/Metadata.pm +++ b/cpan/Module-Metadata/lib/Module/Metadata.pm @@ -1,6 +1,7 @@ # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- # vim:ts=8:sw=2:et:sta:sts=2 -package Module::Metadata; # git description: v1.000026-12-g9b12bf1 +package Module::Metadata; # git description: v1.000028-4-gb283720 +# ABSTRACT: Gather package and POD information from perl module files # Adapted from Perl-licensed code originally distributed with # Module-Build by Ken Williams @@ -13,7 +14,7 @@ sub __clean_eval { eval $_[0] } use strict; use warnings; -our $VERSION = '1.000027'; +our $VERSION = '1.000029'; # TRIAL use Carp qw/croak/; use File::Spec; @@ -30,7 +31,8 @@ BEGIN { Log::Contextual->import('log_info', '-default_logger' => Log::Contextual::WarnLogger->new({ env_prefix => 'MODULE_METADATA', }), ); - } else { + } + else { *log_info = sub (&) { warn $_[0]->() }; } } @@ -173,10 +175,12 @@ sub new_from_module { if ( defined( $version ) ) { if ( $compare_versions->( $version, '!=', $p->{version} ) ) { $err .= " $p->{file} ($p->{version})\n"; - } else { + } + else { # same version declared multiple times, ignore } - } else { + } + else { $file = $p->{file}; $version = $p->{version}; } @@ -242,7 +246,8 @@ sub new_from_module { if ( $files ) { @files = @$files; - } else { + } + else { find( { wanted => sub { push @files, $_ if -f $_ && /\.pm$/; @@ -272,12 +277,14 @@ sub new_from_module { if ( $package eq $prime_package ) { if ( exists( $prime{$package} ) ) { croak "Unexpected conflict in '$package'; multiple versions found.\n"; - } else { + } + else { $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename); $prime{$package}{file} = $mapped_filename; $prime{$package}{version} = $version if defined( $version ); } - } else { + } + else { push( @{$alt{$package}}, { file => $mapped_filename, version => $version, @@ -304,7 +311,8 @@ sub new_from_module { $result->{err} }; - } elsif ( defined( $result->{version} ) ) { + } + elsif ( defined( $result->{version} ) ) { # There is a primary package selected, and exactly one # alternative package @@ -324,19 +332,22 @@ sub new_from_module { }; } - } else { + } + else { # The prime package selected has no version so, we choose to # use any alternative package that does have a version $prime{$package}{file} = $result->{file}; $prime{$package}{version} = $result->{version}; } - } else { + } + else { # no alt package found with a version, but we have a prime # package so we use it whether it has a version or not } - } else { # No primary package was selected, use the best alternative + } + else { # No primary package was selected, use the best alternative if ( $result->{err} ) { log_info { @@ -408,17 +419,12 @@ sub _init { $self->{module} = shift(@candidates); # punt } else { - if(grep /main/, @{$self->{packages}}) { - $self->{module} = 'main'; - } - else { - $self->{module} = $self->{packages}[0] || ''; - } + $self->{module} = 'main'; } } $self->{version} = $self->{versions}{$self->{module}} - if defined( $self->{module} ); + if defined( $self->{module} ); return $self; } @@ -487,9 +493,11 @@ sub _handle_bom { my $encoding; if ( $buf eq "\x{FE}\x{FF}" ) { $encoding = 'UTF-16BE'; - } elsif ( $buf eq "\x{FF}\x{FE}" ) { + } + elsif ( $buf eq "\x{FF}\x{FE}" ) { $encoding = 'UTF-16LE'; - } elsif ( $buf eq "\x{EF}\x{BB}" ) { + } + elsif ( $buf eq "\x{EF}\x{BB}" ) { $buf = ' '; $count = read $fh, $buf, length $buf; if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) { @@ -501,7 +509,8 @@ sub _handle_bom { if ( "$]" >= 5.008 ) { binmode( $fh, ":encoding($encoding)" ); } - } else { + } + else { seek $fh, $pos, SEEK_SET or croak( sprintf "Can't reset position to the top of '$filename'" ); } @@ -544,88 +553,91 @@ sub _parse_fh { $pod_data = ''; } $pod_sect = $1; - - } elsif ( $self->{collect_pod} ) { + } + elsif ( $self->{collect_pod} ) { $pod_data .= "$line\n"; - } - - } elsif ( $is_cut ) { - + next; + } + elsif ( $is_cut ) { if ( $self->{collect_pod} && length( $pod_data ) ) { $pod{$pod_sect} = $pod_data; $pod_data = ''; } $pod_sect = ''; + next; + } - } else { + # Skip after __END__ + next if $in_end; - # Skip after __END__ - next if $in_end; + # Skip comments in code + next if $line =~ /^\s*#/; - # Skip comments in code - next if $line =~ /^\s*#/; + # Would be nice if we could also check $in_string or something too + if ($line eq '__END__') { + $in_end++; + next; + } - # Would be nice if we could also check $in_string or something too - if ($line eq '__END__') { - $in_end++; - next; + last if $line eq '__DATA__'; + + # parse $line to see if it's a $VERSION declaration + my( $version_sigil, $version_fullname, $version_package ) = + index($line, 'VERSION') >= 1 + ? $self->_parse_version_expression( $line ) + : (); + + if ( $line =~ /$PKG_REGEXP/o ) { + $package = $1; + my $version = $2; + push( @packages, $package ) unless grep( $package eq $_, @packages ); + $need_vers = defined $version ? 0 : 1; + + if ( not exists $vers{$package} and defined $version ){ + # Upgrade to a version object. + my $dwim_version = eval { _dwim_version($version) }; + croak "Version '$version' from $self->{filename} does not appear to be valid:\n$line\n\nThe fatal error was: $@\n" + unless defined $dwim_version; # "0" is OK! + $vers{$package} = $dwim_version; } - last if $line eq '__DATA__'; - - # parse $line to see if it's a $VERSION declaration - my( $version_sigil, $version_fullname, $version_package ) = - index($line, 'VERSION') >= 1 - ? $self->_parse_version_expression( $line ) - : (); - - if ( $line =~ /$PKG_REGEXP/o ) { - $package = $1; - my $version = $2; - push( @packages, $package ) unless grep( $package eq $_, @packages ); - $need_vers = defined $version ? 0 : 1; - - if ( not exists $vers{$package} and defined $version ){ - # Upgrade to a version object. - my $dwim_version = eval { _dwim_version($version) }; - croak "Version '$version' from $self->{filename} does not appear to be valid:\n$line\n\nThe fatal error was: $@\n" - unless defined $dwim_version; # "0" is OK! - $vers{$package} = $dwim_version; - } + } - # VERSION defined with full package spec, i.e. $Module::VERSION - } elsif ( $version_fullname && $version_package ) { - push( @packages, $version_package ) unless grep( $version_package eq $_, @packages ); - $need_vers = 0 if $version_package eq $package; + # VERSION defined with full package spec, i.e. $Module::VERSION + elsif ( $version_fullname && $version_package ) { + # we do NOT save this package in found @packages + $need_vers = 0 if $version_package eq $package; - unless ( defined $vers{$version_package} && length $vers{$version_package} ) { + unless ( defined $vers{$version_package} && length $vers{$version_package} ) { $vers{$version_package} = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); } + } - # first non-comment line in undeclared package main is VERSION - } elsif ( $package eq 'main' && $version_fullname && !exists($vers{main}) ) { - $need_vers = 0; - my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); - $vers{$package} = $v; - push( @packages, 'main' ); + # first non-comment line in undeclared package main is VERSION + elsif ( $package eq 'main' && $version_fullname && !exists($vers{main}) ) { + $need_vers = 0; + my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); + $vers{$package} = $v; + push( @packages, 'main' ); + } - # first non-comment line in undeclared package defines package main - } elsif ( $package eq 'main' && !exists($vers{main}) && $line =~ /\w/ ) { - $need_vers = 1; - $vers{main} = ''; - push( @packages, 'main' ); + # first non-comment line in undeclared package defines package main + elsif ( $package eq 'main' && !exists($vers{main}) && $line =~ /\w/ ) { + $need_vers = 1; + $vers{main} = ''; + push( @packages, 'main' ); + } - # only keep if this is the first $VERSION seen - } elsif ( $version_fullname && $need_vers ) { - $need_vers = 0; - my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); + # only keep if this is the first $VERSION seen + elsif ( $version_fullname && $need_vers ) { + $need_vers = 0; + my $v = $self->_evaluate_version_line( $version_sigil, $version_fullname, $line ); - unless ( defined $vers{$package} && length $vers{$package} ) { - $vers{$package} = $v; - } + unless ( defined $vers{$package} && length $vers{$package} ) { + $vers{$package} = $v; } } - } + } # end loop over each line if ( $self->{collect_pod} && length($pod_data) ) { $pod{$pod_sect} = $pod_data; @@ -652,7 +664,8 @@ sub _evaluate_version_line { sub { local $sigil$variable_name; $line; - \$$variable_name + return \$$variable_name if defined \$$variable_name; + return \$Module::Metadata::_version::p${pn}::$variable_name; }; }; @@ -763,7 +776,8 @@ sub version { if ( defined( $mod ) && length( $mod ) && exists( $self->{versions}{$mod} ) ) { return $self->{versions}{$mod}; - } else { + } + else { return undef; } } @@ -774,7 +788,8 @@ sub pod { if ( defined( $sect ) && length( $sect ) && exists( $self->{pod}{$sect} ) ) { return $self->{pod}{$sect}; - } else { + } + else { return undef; } } @@ -793,10 +808,20 @@ sub is_indexable { 1; +__END__ + +=pod + +=encoding UTF-8 + =head1 NAME Module::Metadata - Gather package and POD information from perl module files +=head1 VERSION + +version 1.000029 + =head1 SYNOPSIS use Module::Metadata; @@ -996,11 +1021,24 @@ Returns the POD data in the given section. =head2 C<< is_indexable($package) >> or C<< is_indexable() >> +Available since version 1.000020. + Returns a boolean indicating whether the package (if provided) or any package (otherwise) is eligible for indexing by PAUSE, the Perl Authors Upload Server. Note This only checks for valid C<package> declarations, and does not take any ownership information into account. +=head1 SUPPORT + +Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Module-Metadata> +(or L<bug-Module-Metadata@rt.cpan.org|mailto:bug-Module-Metadata@rt.cpan.org>). + +There is also a mailing list available for users of this distribution, at +http://lists.perl.org/list/cpan-workers.html. + +There is also an irc channel available for users of this distribution, at +irc://irc.perl.org/#toolchain. + =head1 AUTHOR Original code from Module::Build::ModuleInfo by Ken Williams @@ -1009,6 +1047,98 @@ Original code from Module::Build::ModuleInfo by Ken Williams Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with assistance from David Golden (xdg) <dagolden@cpan.org>. +=head1 CONTRIBUTORS + +=for stopwords Karen Etheridge David Golden Vincent Pit Matt S Trout Chris Nehren Graham Knop Olivier Mengué Tomas Doran Tatsuhiko Miyagawa tokuhirom Peter Rabbitson Jerry D. Hedden Craig A. Berry Mitchell Steinbrunner Edward Zborowski Gareth Harper James Raspass 'BinGOs' Williams Josh Jore Kent Fredric + +=over 4 + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +David Golden <dagolden@cpan.org> + +=item * + +Vincent Pit <perl@profvince.com> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=item * + +Chris Nehren <apeiron@cpan.org> + +=item * + +Graham Knop <haarg@haarg.org> + +=item * + +Olivier Mengué <dolmen@cpan.org> + +=item * + +Tomas Doran <bobtfish@bobtfish.net> + +=item * + +Tatsuhiko Miyagawa <miyagawa@bulknews.net> + +=item * + +tokuhirom <tokuhirom@gmail.com> + +=item * + +Peter Rabbitson <ribasushi@cpan.org> + +=item * + +Jerry D. Hedden <jdhedden@cpan.org> + +=item * + +Craig A. Berry <cberry@cpan.org> + +=item * + +David Mitchell <davem@iabyn.com> + +=item * + +David Steinbrunner <dsteinbrunner@pobox.com> + +=item * + +Edward Zborowski <ed@rubensteintech.com> + +=item * + +Gareth Harper <gareth@broadbean.com> + +=item * + +James Raspass <jraspass@gmail.com> + +=item * + +Chris 'BinGOs' Williams <chris@bingosnet.co.uk> + +=item * + +Josh Jore <jjore@cpan.org> + +=item * + +Kent Fredric <kentnl@cpan.org> + +=back + =head1 COPYRIGHT & LICENSE Original code Copyright (c) 2001-2011 Ken Williams. diff --git a/cpan/Module-Metadata/t/extract-package.t b/cpan/Module-Metadata/t/extract-package.t new file mode 100644 index 0000000000..640b23938b --- /dev/null +++ b/cpan/Module-Metadata/t/extract-package.t @@ -0,0 +1,146 @@ +use strict; +use warnings; +# vim:ts=8:sw=2:et:sta:sts=2 + +use Test::More 0.82; +use Module::Metadata; + +use lib 't/lib'; +use GeneratePackage; + +# parse package names +# format: { +# name => test name +# code => code snippet (string) +# package => expected package names +# } +my @pkg_names = ( +{ + name => 'package NAME', + package => [ 'Simple' ], + code => <<'---', +package Simple; +--- +}, +{ + name => 'package NAME::SUBNAME', + package => [ 'Simple::Edward' ], + code => <<'---', +package Simple::Edward; +--- +}, +{ + name => 'package NAME::SUBNAME::', + package => [ 'Simple::Edward::' ], + code => <<'---', +package Simple::Edward::; +--- +}, +{ + name => "package NAME'SUBNAME", + package => [ "Simple'Edward" ], + code => <<'---', +package Simple'Edward; +--- +}, +{ + name => "package NAME'SUBNAME::", + package => [ "Simple'Edward::" ], + code => <<'---', +package Simple'Edward::; +--- +}, +{ + name => 'package NAME::::SUBNAME', + package => [ 'Simple::::Edward' ], + code => <<'---', +package Simple::::Edward; +--- +}, +{ + name => 'package ::NAME::SUBNAME', + package => [ '::Simple::Edward' ], + code => <<'---', +package ::Simple::Edward; +--- +}, +{ + name => 'package NAME:SUBNAME (fail)', + package => [ 'main' ], + code => <<'---', +package Simple:Edward; +--- +}, +{ + name => "package NAME' (fail)", + package => [ 'main' ], + code => <<'---', +package Simple'; +--- +}, +{ + name => "package NAME::SUBNAME' (fail)", + package => [ 'main' ], + code => <<'---', +package Simple::Edward'; +--- +}, +{ + name => "package NAME''SUBNAME (fail)", + package => [ 'main' ], + code => <<'---', +package Simple''Edward; +--- +}, +{ + name => 'package NAME-SUBNAME (fail)', + package => [ 'main' ], + code => <<'---', +package Simple-Edward; +--- +}, +{ + name => 'no assumption of package merely if its $VERSION is referenced', + package => [ 'Simple' ], + code => <<'---', +package Simple; +$Foo::Bar::VERSION = '1.23'; +--- +}, +); + +my $test_num = 0; + +my $tmpdir = GeneratePackage::tmpdir(); + +foreach my $test_case (@pkg_names) { + note '-------'; + note $test_case->{name}; + my $code = $test_case->{code}; + my $expected_name = $test_case->{package}; + local $TODO = $test_case->{TODO}; + + my $warnings = ''; + local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; + + my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catdir($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'); + + # Test::Builder will prematurely numify objects, so use this form + my $errs; + my @got = $pm_info->packages_inside(); + is_deeply( \@got, $expected_name, + "case $test_case->{name}: correct package names (expected '" . join(', ', @$expected_name) . "')" ) + or $errs++; + is( $warnings, '', "case $test_case->{name}: no warnings from parsing" ) or $errs++; + diag "Got: '" . join(', ', @got) . "'\nModule contents:\n$code" if $errs; +} +continue { + ++$test_num; +} + +done_testing; diff --git a/cpan/Module-Metadata/t/extract-version.t b/cpan/Module-Metadata/t/extract-version.t new file mode 100644 index 0000000000..3329aa1b84 --- /dev/null +++ b/cpan/Module-Metadata/t/extract-version.t @@ -0,0 +1,683 @@ +use strict; +use warnings; +# vim:ts=8:sw=2:et:sta:sts=2 + +use Test::More 0.82; +use Data::Dumper; +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 => '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 => '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 => 'FIXME! RT#74741', +}, +{ + name => 'no package statement; bare $VERSION with our', + code => <<'---', +our $VERSION = '1.23'; +--- + vers => undef, + all_versions => { '____caller' => '1.23' }, + TODO => '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' }, +}, +); + +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}; + local $TODO = $test_case->{TODO}; + 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->catdir($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. + isa_ok($got, 'version') if defined $expected_version; + + if (ref($expected_version) eq 'CODE') { + ok( + $expected_version->($got), + "case '$test_case->{name}': module version passes match sub" + ) + or $errs++; + } + else { + 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}) { + 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 diag 'found versions: ', explain $pm_info->{versions}; + } + else { + is_deeply( + $pm_info->{versions}, + $test_case->{all_versions}, + 'correctly found all $VERSIONs', + ) or diag 'found versions: ', explain $pm_info->{versions}; + } + } + + is( $warnings, '', "case '$test_case->{name}': no warnings from parsing" ) or $errs++; + diag Dumper({ got => $pm_info->version, module_contents => $code }) if $errs; + } +} +continue { + ++$test_num; +} + +done_testing; diff --git a/cpan/Module-Metadata/t/lib/GeneratePackage.pm b/cpan/Module-Metadata/t/lib/GeneratePackage.pm new file mode 100644 index 0000000000..c2e9e16cda --- /dev/null +++ b/cpan/Module-Metadata/t/lib/GeneratePackage.pm @@ -0,0 +1,38 @@ +use strict; +use warnings; +package GeneratePackage; +# vim:ts=8:sw=2:et:sta:sts=2 + +use base 'Exporter'; +our @EXPORT = qw(tmpdir generate_file); + +use Cwd; +use File::Spec; +use File::Path; +use File::Temp; +use IO::File; + +sub tmpdir { + File::Temp::tempdir( + 'MMD-XXXXXXXX', + CLEANUP => 0, + DIR => ($ENV{PERL_CORE} ? File::Spec->rel2abs(Cwd::cwd) : File::Spec->tmpdir), + ); +} + +sub generate_file { + my ($dir, $rel_filename, $content) = @_; + + File::Path::mkpath($dir) or die "failed to create '$dir'"; + my $abs_filename = File::Spec->catfile($dir, $rel_filename); + + Test::More::note("working on $abs_filename"); + + my $fh = IO::File->new(">$abs_filename") or die "Can't write '$abs_filename'\n"; + print $fh $content; + close $fh; + + return $abs_filename; +} + +1; diff --git a/cpan/Module-Metadata/t/metadata.t b/cpan/Module-Metadata/t/metadata.t index 67c68a9c5f..068a8657b1 100644 --- a/cpan/Module-Metadata/t/metadata.t +++ b/cpan/Module-Metadata/t/metadata.t @@ -12,281 +12,7 @@ use Cwd (); use File::Path; use Data::Dumper; -my $undef; - -# parse various module $VERSION lines -# format: expected version => code snippet -my @modules = ( - $undef => <<'---', # no $VERSION line -package Simple; ---- - $undef => <<'---', # undefined $VERSION -package Simple; -our $VERSION; ---- - '1.23' => <<'---', # declared & defined on same line with 'our' -package Simple; -our $VERSION = '1.23'; ---- - '1.23' => <<'---', # declared & defined on separate lines with 'our' -package Simple; -our $VERSION; -$VERSION = '1.23'; ---- - '1.23' => <<'---', # commented & defined on same line -package Simple; -our $VERSION = '1.23'; # our $VERSION = '4.56'; ---- - '1.23' => <<'---', # commented & defined on separate lines -package Simple; -# our $VERSION = '4.56'; -our $VERSION = '1.23'; ---- - '1.23' => <<'---', # use vars -package Simple; -use vars qw( $VERSION ); -$VERSION = '1.23'; ---- - '1.23' => <<'---', # choose the right default package based on package/file name -package Simple::_private; -$VERSION = '0'; -package Simple; -$VERSION = '1.23'; # this should be chosen for version ---- - '1.23' => <<'---', # just read the first $VERSION line -package Simple; -$VERSION = '1.23'; # we should see this line -$VERSION = eval $VERSION; # and ignore this one ---- - '1.23' => <<'---', # just read the first $VERSION line in reopened package (1) -package Simple; -$VERSION = '1.23'; -package Error::Simple; -$VERSION = '2.34'; -package Simple; ---- - '1.23' => <<'---', # just read the first $VERSION line in reopened package (2) -package Simple; -package Error::Simple; -$VERSION = '2.34'; -package Simple; -$VERSION = '1.23'; ---- - '1.23' => <<'---', # mentions another module's $VERSION -package Simple; -$VERSION = '1.23'; -if ( $Other::VERSION ) { - # whatever -} ---- - '1.23' => <<'---', # mentions another module's $VERSION in a different package -package Simple; -$VERSION = '1.23'; -package Simple2; -if ( $Simple::VERSION ) { - # whatever -} ---- - '1.23' => <<'---', # $VERSION checked only in assignments, not regexp ops -package Simple; -$VERSION = '1.23'; -if ( $VERSION =~ /1\.23/ ) { - # whatever -} ---- - '1.23' => <<'---', # $VERSION checked only in assignments, not relational ops -package Simple; -$VERSION = '1.23'; -if ( $VERSION == 3.45 ) { - # whatever -} ---- - '1.23' => <<'---', # $VERSION checked only in assignments, not relational ops -package Simple; -$VERSION = '1.23'; -package Simple2; -if ( $Simple::VERSION == 3.45 ) { - # whatever -} ---- - '1.23' => <<'---', # Fully qualified $VERSION declared in package -package Simple; -$Simple::VERSION = 1.23; ---- - '1.23' => <<'---', # Differentiate fully qualified $VERSION in a package -package Simple; -$Simple2::VERSION = '999'; -$Simple::VERSION = 1.23; ---- - '1.23' => <<'---', # Differentiate fully qualified $VERSION and unqualified -package Simple; -$Simple2::VERSION = '999'; -$VERSION = 1.23; ---- - '1.23' => <<'---', # $VERSION declared as package variable from within 'main' package -$Simple::VERSION = '1.23'; -{ - package Simple; - $x = $y, $cats = $dogs; -} ---- - '1.23' => <<'---', # $VERSION wrapped in parens - space inside -package Simple; -( $VERSION ) = '1.23'; ---- - '1.23' => <<'---', # $VERSION wrapped in parens - no space inside -package Simple; -($VERSION) = '1.23'; ---- - '1.23' => <<'---', # $VERSION follows a spurious 'package' in a quoted construct -package Simple; -__PACKAGE__->mk_accessors(qw( - program socket proc - package filename line codeline subroutine finished)); - -our $VERSION = "1.23"; ---- - '1.23' => <<'---', # $VERSION using version.pm - package Simple; - use version; our $VERSION = version->new('1.23'); ---- - 'v1.230' => <<'---', # $VERSION using version.pm and qv() - package Simple; - use version; our $VERSION = qv('1.230'); ---- - '1.230' => <<'---', # Two version assignments, should ignore second one - $Simple::VERSION = '1.230'; - $Simple::VERSION = eval $Simple::VERSION; ---- - '1.230000' => <<'---', # declared & defined on same line with 'our' -package Simple; -our $VERSION = '1.23_00_00'; ---- - '1.23' => <<'---', # package NAME VERSION - package Simple 1.23; ---- - '1.23_01' => <<'---', # package NAME VERSION - package Simple 1.23_01; ---- - 'v1.2.3' => <<'---', # package NAME VERSION - package Simple v1.2.3; ---- - 'v1.2_3' => <<'---', # package NAME VERSION - package Simple v1.2_3; ---- - '1.23' => <<'---', # trailing crud - package Simple; - our $VERSION; - $VERSION = '1.23-alpha'; ---- - '1.23' => <<'---', # trailing crud - package Simple; - our $VERSION; - $VERSION = '1.23b'; ---- - '1.234' => <<'---', # multi_underscore - package Simple; - our $VERSION; - $VERSION = '1.2_3_4'; ---- - '0' => <<'---', # non-numeric - package Simple; - our $VERSION; - $VERSION = 'onetwothree'; ---- - $undef => <<'---', # package NAME BLOCK, undef $VERSION -package Simple { - our $VERSION; -} ---- - '1.23' => <<'---', # package NAME BLOCK, with $VERSION -package Simple { - our $VERSION = '1.23'; -} ---- - '1.23' => <<'---', # package NAME VERSION BLOCK -package Simple 1.23 { - 1; -} ---- - 'v1.2.3_4' => <<'---', # package NAME VERSION BLOCK -package Simple v1.2.3_4 { - 1; -} ---- - '0' => <<'---', # set from separately-initialised variable -package Simple; - our $CVSVERSION = '$Revision: 1.7 $'; - our ($VERSION) = ($CVSVERSION =~ /(\d+\.\d+)/); -} ---- - 'v2.2.102.2' => <<'---', # our + bare v-string -package Simple; -our $VERSION = v2.2.102.2; ---- - '0.0.9_1' => <<'---', # our + dev release -package Simple; -our $VERSION = "0.0.9_1"; ---- - '1.12' => <<'---', # our + crazy string and substitution code -package Simple; -our $VERSION = '1.12.B55J2qn'; our $WTF = $VERSION; $WTF =~ s/^\d+\.\d+\.//; # attempts to rationalize $WTF go here. ---- - '1.12' => <<'---', # our in braces, as in Dist::Zilla::Plugin::PkgVersion with use_our = 1 -package Simple; -{ our $VERSION = '1.12'; } ---- - sub { defined $_[0] and $_[0] =~ /^3\.14159/ } => <<'---', # calculated version - from Acme-Pi-3.14 -package Simple; -my $version = atan2(1,1) * 4; $Simple::VERSION = "$version"; -1; ---- -); - -# format: expected package name => code snippet -my @pkg_names = ( - [ 'Simple' ] => <<'---', # package NAME -package Simple; ---- - [ 'Simple::Edward' ] => <<'---', # package NAME::SUBNAME -package Simple::Edward; ---- - [ 'Simple::Edward::' ] => <<'---', # package NAME::SUBNAME:: -package Simple::Edward::; ---- - [ "Simple'Edward" ] => <<'---', # package NAME'SUBNAME -package Simple'Edward; ---- - [ "Simple'Edward::" ] => <<'---', # package NAME'SUBNAME:: -package Simple'Edward::; ---- - [ 'Simple::::Edward' ] => <<'---', # package NAME::::SUBNAME -package Simple::::Edward; ---- - [ '::Simple::Edward' ] => <<'---', # package ::NAME::SUBNAME -package ::Simple::Edward; ---- - [ 'main' ] => <<'---', # package NAME:SUBNAME (fail) -package Simple:Edward; ---- - [ 'main' ] => <<'---', # package NAME' (fail) -package Simple'; ---- - [ 'main' ] => <<'---', # package NAME::SUBNAME' (fail) -package Simple::Edward'; ---- - [ 'main' ] => <<'---', # package NAME''SUBNAME (fail) -package Simple''Edward; ---- - [ 'main' ] => <<'---', # package NAME-SUBNAME (fail) -package Simple-Edward; ---- -); - -# 2 tests per each pair of @modules (plus 1 for defined keys), 2 per pair of @pkg_names -plan tests => 63 - + ( @modules + grep { defined $modules[2*$_] } 0..$#modules/2 ) - + ( @pkg_names ); +plan tests => 61; require_ok('Module::Metadata'); @@ -395,73 +121,6 @@ END { } -# iterate through @modules pairwise -my $test_case = 0; -while (++$test_case and my ($expected_version, $code) = splice @modules, 0, 2 ) { - 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 $file = File::Spec->catfile('lib', 'Simple.pm'); - my ($dist_name, $dist_dir) = new_dist(files => { $file => $code }); - - my $warnings = ''; - local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; - my $pm_info = Module::Metadata->new_from_file( $file ); - - 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. - isa_ok($got, 'version') if defined $expected_version; - - if (ref($expected_version) eq 'CODE') { - ok( - $expected_version->($got), - "case $test_case: module version passes match sub" - ) - or $errs++; - } - else { - is( - (defined $got ? "$got" : $got), - $expected_version, - "case $test_case: correct module version (" - . (defined $expected_version? "'$expected_version'" : 'undef') - . ')' - ) - or $errs++; - } - - is( $warnings, '', "case $test_case: no warnings from parsing" ) or $errs++; - diag Dumper({ got => $pm_info->version, module_contents => $code }) if $errs; - } -} - -$test_case = 0; -while (++$test_case and my ($expected_name, $code) = splice @pkg_names, 0, 2) { - my $file = File::Spec->catfile('lib', 'Simple.pm'); - my ($dist_name, $dist_dir) = new_dist(files => { $file => $code }); - - my $warnings = ''; - local $SIG{__WARN__} = sub { $warnings .= $_ for @_ }; - my $pm_info = Module::Metadata->new_from_file( $file ); - - # Test::Builder will prematurely numify objects, so use this form - my $errs; - my @got = $pm_info->packages_inside(); - is_deeply( \@got, $expected_name, - "case $test_case: correct package names (expected '" . join(', ', @$expected_name) . "')" ) - or $errs++; - is( $warnings, '', "case $test_case: no warnings from parsing" ) or $errs++; - diag "Got: '" . join(', ', @got) . "'\nModule contents:\n$code" if $errs; -} - { # Find each package only once my $file = File::Spec->catfile('lib', 'Simple.pm'); @@ -494,29 +153,6 @@ $VERSION = '1.23'; is( $pm_info->version, undef, 'no version w/o default package' ); } -{ - # Module 'Simple.pm' contains an alpha version - # constructor should report first $VERSION found - my $file = File::Spec->catfile('lib', 'Simple.pm'); - my ($dist_name, $dist_dir) = new_dist(files => { $file => <<'---' } ); -package Simple; -$VERSION = '1.23_01'; -$VERSION = eval $VERSION; ---- - - my $pm_info = Module::Metadata->new_from_file( $file ); - - is( $pm_info->version, '1.23_01', 'alpha version reported'); - - # NOTE the following test has be done this way because Test::Builder is - # too smart for our own good and tries to see if the version object is a - # dual-var, which breaks with alpha versions: - # Argument "1.23_0100" isn't numeric in addition (+) at - # /usr/lib/perl5/5.8.7/Test/Builder.pm line 505. - - ok( $pm_info->version > 1.23, 'alpha version greater than non'); -} - # parse $VERSION lines scripts for package main my @scripts = ( <<'---', # package main declared |