In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8255316ac82c0fbd7ae49f2f9a217ce063d7bbfb?hp=bfea06111a748a3087983fe3342c57695202d016>
- Log ----------------------------------------------------------------- commit 8255316ac82c0fbd7ae49f2f9a217ce063d7bbfb Author: Karen Etheridge <[email protected]> Date: Sun May 15 19:19:01 2016 -0700 upgrade Module-Metadata to 1.000032 M Porting/Maintainers.pl M cpan/Module-Metadata/lib/Module/Metadata.pm M cpan/Module-Metadata/t/extract-package.t M cpan/Module-Metadata/t/extract-version.t M cpan/Module-Metadata/t/metadata.t commit 0f5c5828d46288412e1703ea0844560c69734fec Author: Karen Etheridge <[email protected]> Date: Sun May 15 19:18:39 2016 -0700 fix typo in RMG M Porting/release_managers_guide.pod ----------------------------------------------------------------------- Summary of changes: Porting/Maintainers.pl | 2 +- Porting/release_managers_guide.pod | 2 +- cpan/Module-Metadata/lib/Module/Metadata.pm | 41 ++++++++++++++++----- cpan/Module-Metadata/t/extract-package.t | 24 +++++++++++- cpan/Module-Metadata/t/extract-version.t | 21 ++++++++--- cpan/Module-Metadata/t/metadata.t | 57 +++++++++++++++++++++++++++-- 6 files changed, 125 insertions(+), 22 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index c581008..e3c102d 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -854,7 +854,7 @@ use File::Glob qw(:case); }, 'Module::Metadata' => { - 'DISTRIBUTION' => 'ETHER/Module-Metadata-1.000031-TRIAL.tar.gz', + 'DISTRIBUTION' => 'ETHER/Module-Metadata-1.000032-TRIAL.tar.gz', 'FILES' => q[cpan/Module-Metadata], 'EXCLUDED' => [ qw(t/00-report-prereqs.t), diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod index 3e1e025..0d724e7 100644 --- a/Porting/release_managers_guide.pod +++ b/Porting/release_managers_guide.pod @@ -278,7 +278,7 @@ into the repository anyway. =item * For any new files in the distro, determine whether they are needed. -If not, delete them, and list them in either C<EXCLUDED> or C<@INGORE>. +If not, delete them, and list them in either C<EXCLUDED> or C<@IGNORABLE>. Otherwise, add them to C<MANIFEST>, and run C<git add> to add the files to the repository. diff --git a/cpan/Module-Metadata/lib/Module/Metadata.pm b/cpan/Module-Metadata/lib/Module/Metadata.pm index f7017cf..e8c2b25 100644 --- a/cpan/Module-Metadata/lib/Module/Metadata.pm +++ b/cpan/Module-Metadata/lib/Module/Metadata.pm @@ -1,6 +1,6 @@ # -*- 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.000030-2-g52f466c +# vim:ts=8:sw=2:et:sta:sts=2:tw=78 +package Module::Metadata; # git description: v1.000031-13-g7c061c9 # ABSTRACT: Gather package and POD information from perl module files # Adapted from Perl-licensed code originally distributed with @@ -14,7 +14,7 @@ sub __clean_eval { eval $_[0] } use strict; use warnings; -our $VERSION = '1.000031'; # TRIAL +our $VERSION = '1.000032'; # TRIAL use Carp qw/croak/; use File::Spec; @@ -411,15 +411,29 @@ sub _init { } $self->_parse_fh($handle); + @{$self->{packages}} = __uniq(@{$self->{packages}}); + unless($self->{module} and length($self->{module})) { - my ($v, $d, $f) = File::Spec->splitpath($self->{filename}); - if($f =~ /\.pm$/) { + # CAVEAT (possible TODO): .pmc files not treated the same as .pm + if ($self->{filename} =~ /\.pm$/) { + my ($v, $d, $f) = File::Spec->splitpath($self->{filename}); $f =~ s/\..+$//; - my @candidates = grep /$f$/, @{$self->{packages}}; - $self->{module} = shift(@candidates); # punt + my @candidates = grep /(^|::)$f$/, @{$self->{packages}}; + $self->{module} = shift(@candidates); # this may be undef } else { - $self->{module} = 'main'; + # this seems like an atrocious heuristic, albeit marginally better than + # what was here before. It should be rewritten entirely to be more like + # "if it's not a .pm file, it's not require()able as a name, therefore + # name() should be undef." + if ((grep /main/, @{$self->{packages}}) + or (grep /main/, keys %{$self->{versions}})) { + $self->{module} = 'main'; + } + else { + # TODO: this should maybe default to undef instead + $self->{module} = $self->{packages}[0] || ''; + } } } @@ -440,6 +454,7 @@ sub _do_find_module { my $testfile = File::Spec->catfile($dir, $file); return [ File::Spec->rel2abs( $testfile ), $dir ] if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp + # CAVEAT (possible TODO): .pmc files are not discoverable here $testfile .= '.pm'; return [ File::Spec->rel2abs( $testfile ), $dir ] if -e $testfile; @@ -649,6 +664,12 @@ sub _parse_fh { $self->{pod_headings} = \@pod; } +sub __uniq (@) +{ + my (%seen, $key); + grep { not $seen{ $key = $_ }++ } @_; +} + { my $pn = 0; sub _evaluate_version_line { @@ -820,7 +841,7 @@ Module::Metadata - Gather package and POD information from perl module files =head1 VERSION -version 1.000031 +version 1.000032 =head1 SYNOPSIS @@ -1037,7 +1058,7 @@ There is also a mailing list available for users of this distribution, at L<http://lists.perl.org/list/cpan-workers.html>. There is also an irc channel available for users of this distribution, at -L<irc://irc.perl.org/#toolchain>. +L<C<#toolchain> on C<irc.perl.org>|irc://irc.perl.org/#toolchain>. =head1 AUTHOR diff --git a/cpan/Module-Metadata/t/extract-package.t b/cpan/Module-Metadata/t/extract-package.t index 640b239..db99dae 100644 --- a/cpan/Module-Metadata/t/extract-package.t +++ b/cpan/Module-Metadata/t/extract-package.t @@ -107,6 +107,26 @@ package Simple; $Foo::Bar::VERSION = '1.23'; --- }, +{ + name => 'script 7 from t/metadata.t', # TODO merge these + package => [ '_private', 'main' ], + TODO => '$::VERSION indicates main namespace is referenced', + code => <<'---', +package _private; +$::VERSION = 0.01; +$VERSION = '999'; +--- +}, +{ + name => 'script 8 from t/metadata.t', # TODO merge these + package => [ '_private', 'main' ], + TODO => '$::VERSION indicates main namespace is referenced', + code => <<'---', +package _private; +$VERSION = '999'; +$::VERSION = 0.01; +--- +}, ); my $test_num = 0; @@ -118,7 +138,6 @@ foreach my $test_case (@pkg_names) { 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 @_ }; @@ -133,9 +152,12 @@ foreach my $test_case (@pkg_names) { # Test::Builder will prematurely numify objects, so use this form my $errs; my @got = $pm_info->packages_inside(); + { + local $TODO = $test_case->{TODO}; 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; } diff --git a/cpan/Module-Metadata/t/extract-version.t b/cpan/Module-Metadata/t/extract-version.t index 278a602..16266e8 100644 --- a/cpan/Module-Metadata/t/extract-version.t +++ b/cpan/Module-Metadata/t/extract-version.t @@ -3,7 +3,6 @@ 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'; @@ -602,6 +601,16 @@ $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; @@ -639,8 +648,8 @@ foreach my $test_case (@modules) { # We want to ensure we preserve the original, as long as it's legal, so we # explicitly check the stringified form. { - local $TODO = $test_case->{TODO_got_version}; - isa_ok($got, 'version') if defined $expected_version; + local $TODO = !defined($got) && ($test_case->{TODO_code_sub} || $test_case->{TODO_scalar}); + isa_ok($got, 'version') or $errs++ if defined $expected_version; } if (ref($expected_version) eq 'CODE') { @@ -669,19 +678,19 @@ foreach my $test_case (@modules) { 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 'extracted versions: ', explain({ got => $pm_info->{versions}, module_contents => $code }) if !$ENV{PERL_CORE} && $errs; + diag 'parsed module: ', explain($pm_info) if !$ENV{PERL_CORE} && $errs; } } continue { diff --git a/cpan/Module-Metadata/t/metadata.t b/cpan/Module-Metadata/t/metadata.t index 068a865..8135773 100644 --- a/cpan/Module-Metadata/t/metadata.t +++ b/cpan/Module-Metadata/t/metadata.t @@ -10,9 +10,8 @@ use File::Temp; use File::Basename; use Cwd (); use File::Path; -use Data::Dumper; -plan tests => 61; +plan tests => 70; require_ok('Module::Metadata'); @@ -205,12 +204,17 @@ $::VERSION = 0.01; my ( $i, $n ) = ( 1, scalar( @scripts ) ); foreach my $script ( @scripts ) { + note '-------'; + my $errs; my $file = File::Spec->catfile('bin', 'simple.plx'); my ($dist_name, $dist_dir) = new_dist(files => { $file => $script } ); my $pm_info = Module::Metadata->new_from_file( $file ); - is( $pm_info->version, '0.01', "correct script version ($i of $n)" ); + is( $pm_info->name, 'main', 'name for script is always main'); + is( $pm_info->version, '0.01', "correct script version ($i of $n)" ) or $errs++; $i++; + + diag 'parsed module: ', explain($pm_info) if !$ENV{PERL_CORE} && $errs; } { @@ -324,6 +328,53 @@ our $VERSION = '1.23'; is( $pm_info->version, '1.23', 'version for default package' ); } +my $tmpdir = GeneratePackage::tmpdir(); +my $undef; +my $test_num = 0; +use lib 't/lib'; +use GeneratePackage; + +{ + # and now a real pod file + # (this test case is ready to be rolled into a corpus loop, later) + my $test_case = { + name => 'file only contains pod', + filename => 'Simple/Documentation.pod', + code => <<'---', +# PODNAME: Simple::Documentation +# ABSTRACT: My documentation + +=pod + +Hello, this is pod. + +=cut +--- + module => '', # TODO: should probably be $undef actually + all_versions => { }, + }; + + note $test_case->{name}; + my $code = $test_case->{code}; + my $expected_name = $test_case->{module}; + local $TODO = $test_case->{TODO}; + + my $errs; + + my ($vol, $dir, $basename) = File::Spec->splitpath(File::Spec->catdir($tmpdir, "Simple${test_num}", ($test_case->{filename} || 'Simple.pm'))); + my $pm_info = Module::Metadata->new_from_file(generate_file($dir, $basename, $code)); + + my $got_name = $pm_info->name; + is( + $got_name, + $expected_name, + "case '$test_case->{name}': module name matches", + ) + or $errs++; + + diag 'parsed module: ', explain($pm_info) if !$ENV{PERL_CORE} && $errs; +} + { # Make sure processing stops after __DATA__ my $file = File::Spec->catfile('lib', 'Simple.pm'); -- Perl5 Master Repository
