search

Perl / perl5

🐪 The Perl programming language
https://dev.perl.org/perl5/
Other
1.88k stars 530 forks source link

PATCH: Upgrade Module-Metadata from 1.000027 to 1.000029-TRIAL #14952

Closed p5pRT closed 8 years ago

p5pRT commented 8 years ago

Migrated from rt.perl.org#126230 (status was 'resolved')

Searchable as RT126230$

p5pRT commented 8 years ago

From @karenetheridge

Upgrade Module-Metadata from 1.000027 to 1.000029-TRIAL (putting a trial version in blead is very much intentional\, to improve smoke coverage)

p5pRT commented 8 years ago

From @karenetheridge

0001-Upgrade-Module-Metadata-from-1.000027-to-1.000029-TR.patch ```diff From 7387b25fb92eade6225c42f6d27717d1c13479df Mon Sep 17 00:00:00 2001 From: Karen Etheridge Date: Wed, 30 Sep 2015 21:30:20 -0700 Subject: [PATCH] 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 meta files omitted: CONTRIBUTING Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL README dist.ini lib/Module/Metadata.pm 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 --- cpan/Module-Metadata/lib/Module/Metadata.pm | 304 ++++++++---- cpan/Module-Metadata/t/extract-package.t | 146 ++++++ cpan/Module-Metadata/t/extract-version.t | 683 ++++++++++++++++++++++++++ cpan/Module-Metadata/t/lib/GeneratePackage.pm | 38 ++ cpan/Module-Metadata/t/metadata.t | 366 +------------- 5 files changed, 1085 insertions(+), 452 deletions(-) create mode 100644 cpan/Module-Metadata/t/extract-package.t create mode 100644 cpan/Module-Metadata/t/extract-version.t create mode 100644 cpan/Module-Metadata/t/lib/GeneratePackage.pm diff --git a/cpan/Module-Metadata/lib/Module/Metadata.pm b/cpan/Module-Metadata/lib/Module/Metadata.pm index 2fa75c1..3fa404e 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 ) - : (); + # 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; - 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; - - 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 ); + # 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' ); + } + + # 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; - 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 ); - - 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 declarations, and does not take any ownership information into account. +=head1 SUPPORT + +Bugs may be submitted through L +(or L). + +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) with assistance from David Golden (xdg) . +=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 + +=item * + +David Golden + +=item * + +Vincent Pit + +=item * + +Matt S Trout + +=item * + +Chris Nehren + +=item * + +Graham Knop + +=item * + +Olivier Mengu�� + +=item * + +Tomas Doran + +=item * + +Tatsuhiko Miyagawa + +=item * + +tokuhirom + +=item * + +Peter Rabbitson + +=item * + +Jerry D. Hedden + +=item * + +Craig A. Berry + +=item * + +David Mitchell + +=item * + +David Steinbrunner + +=item * + +Edward Zborowski + +=item * + +Gareth Harper + +=item * + +James Raspass + +=item * + +Chris 'BinGOs' Williams + +=item * + +Josh Jore + +=item * + +Kent Fredric + +=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 0000000..640b239 --- /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 0000000..3329aa1 --- /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 0000000..c2e9e16 --- /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 67c68a9..068a865 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 -- 2.4.5 ```
p5pRT commented 8 years ago

From @jkeenan

On Wed Sep 30 21​:39​:28 2015\, ether wrote​:

Upgrade Module-Metadata from 1.000027 to 1.000029-TRIAL (putting a trial version in blead is very much intentional\, to improve smoke coverage)

Karen\, when I tried to apply this to blead I got 3 test failures in t/porting/manifest.t. See attached.

Could you take a look?

Thank you very much.

-- James E Keenan (jkeenan@​cpan.org)

p5pRT commented 8 years ago

From @jkeenan

ok 10043 - MANIFEST sorted properly not ok 10044 - git ls-files gives the same number of files as MANIFEST lists ok 10045 - no duplicate files in MANIFEST not ok 10046 - Nothing added to the repo that isn't in MANIFEST not ok 10047 - Nothing added to the repo that isn't in MANIFEST ok 10048 - Nothing in the MANIFEST that isn't tracked by git ok 10049 - Nothing in the MANIFEST that isn't tracked by git # Failed test 10044 - git ls-files gives the same number of files as MANIFEST lists at porting/manifest.t line 91 # got "5679" # expected "5676" # Failed test 10046 - Nothing added to the repo that isn't in MANIFEST at porting/manifest.t line 103 # got "3" # expected "0" # Failed test 10047 - Nothing added to the repo that isn't in MANIFEST at porting/manifest.t line 104 # got "not in MANIFEST​: cpan/Module-Metadata/t/lib/GeneratePackage.pm cpan/Module-Metadata/t/extract-version.t cpan/Module-Metadata/t/extract-package.t" # expected "not in MANIFEST​: " Failed 3/10049 subtests

Test Summary Report

porting/manifest.t (Wstat​: 0 Tests​: 10049 Failed​: 3)   Failed tests​: 10044\, 10046-10047 Files=1\, Tests=10049\, 1 wallclock secs ( 0.63 usr 0.05 sys + 0.14 cusr 0.01 csys = 0.83 CPU) Result​: FAIL

p5pRT commented 8 years ago

The RT System itself - Status changed from 'new' to 'open'

p5pRT commented 8 years ago

From @karenetheridge

On Thu Oct 01 03​:53​:18 2015\, jkeenan wrote​:

On Wed Sep 30 21​:39​:28 2015\, ether wrote​:

Upgrade Module-Metadata from 1.000027 to 1.000029-TRIAL (putting a trial version in blead is very much intentional\, to improve smoke coverage)

Karen\, when I tried to apply this to blead I got 3 test failures in t/porting/manifest.t. See attached.

Apologies\, I missed those errors!

Here is a revised patch that amends MANIFEST appropriately to reflect the new test files that were added. All tests pass.

p5pRT commented 8 years ago

From @karenetheridge

0001-Upgrade-Module-Metadata-from-1.000027-to-1.000029-TR.patch ```diff From 198debef8c50c88bdae26337d30774e5895aa2bb Mon Sep 17 00:00:00 2001 From: Karen Etheridge Date: Wed, 30 Sep 2015 21:30:20 -0700 Subject: [PATCH] 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 --- MANIFEST | 3 + cpan/Module-Metadata/lib/Module/Metadata.pm | 304 ++++++++---- cpan/Module-Metadata/t/extract-package.t | 146 ++++++ cpan/Module-Metadata/t/extract-version.t | 683 ++++++++++++++++++++++++++ cpan/Module-Metadata/t/lib/GeneratePackage.pm | 38 ++ cpan/Module-Metadata/t/metadata.t | 366 +------------- 6 files changed, 1088 insertions(+), 452 deletions(-) create mode 100644 cpan/Module-Metadata/t/extract-package.t create mode 100644 cpan/Module-Metadata/t/extract-version.t create mode 100644 cpan/Module-Metadata/t/lib/GeneratePackage.pm diff --git a/MANIFEST b/MANIFEST index 87d4c6e..7ae4148 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1756,9 +1756,12 @@ cpan/Module-Metadata/lib/Module/Metadata.pm cpan/Module-Metadata/t/contains_pod.t cpan/Module-Metadata/t/encoding.t cpan/Module-Metadata/t/endpod.t +cpan/Module-Metadata/t/extract-package.t +cpan/Module-Metadata/t/extract-version.t cpan/Module-Metadata/t/lib/0_1/Foo.pm cpan/Module-Metadata/t/lib/0_2/Foo.pm cpan/Module-Metadata/t/lib/ENDPOD.pm +cpan/Module-Metadata/t/lib/GeneratePackage.pm cpan/Module-Metadata/t/metadata.t cpan/Module-Metadata/t/taint.t cpan/Module-Metadata/t/version.t diff --git a/cpan/Module-Metadata/lib/Module/Metadata.pm b/cpan/Module-Metadata/lib/Module/Metadata.pm index 2fa75c1..3fa404e 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 ) - : (); + # 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; - 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; - - 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 ); + # 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' ); + } + + # 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; - 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 ); - - 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 declarations, and does not take any ownership information into account. +=head1 SUPPORT + +Bugs may be submitted through L +(or L). + +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) with assistance from David Golden (xdg) . +=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 + +=item * + +David Golden + +=item * + +Vincent Pit + +=item * + +Matt S Trout + +=item * + +Chris Nehren + +=item * + +Graham Knop + +=item * + +Olivier Mengu�� + +=item * + +Tomas Doran + +=item * + +Tatsuhiko Miyagawa + +=item * + +tokuhirom + +=item * + +Peter Rabbitson + +=item * + +Jerry D. Hedden + +=item * + +Craig A. Berry + +=item * + +David Mitchell + +=item * + +David Steinbrunner + +=item * + +Edward Zborowski + +=item * + +Gareth Harper + +=item * + +James Raspass + +=item * + +Chris 'BinGOs' Williams + +=item * + +Josh Jore + +=item * + +Kent Fredric + +=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 0000000..640b239 --- /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 0000000..3329aa1 --- /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 0000000..c2e9e16 --- /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 67c68a9..068a865 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 -- 2.4.5 ```
p5pRT commented 8 years ago

From @jkeenan

On Thu Oct 01 11​:14​:41 2015\, ether wrote​:

On Thu Oct 01 03​:53​:18 2015\, jkeenan wrote​:

On Wed Sep 30 21​:39​:28 2015\, ether wrote​:

Upgrade Module-Metadata from 1.000027 to 1.000029-TRIAL (putting a trial version in blead is very much intentional\, to improve smoke coverage)

Karen\, when I tried to apply this to blead I got 3 test failures in t/porting/manifest.t. See attached.

Apologies\, I missed those errors!

Here is a revised patch that amends MANIFEST appropriately to reflect the new test files that were added. All tests pass.

Pushed to blead in commit 0fa1f7e4e66a455cab6ccf1f9c49f2373c1ced80

When I ran make harness on Linux x86_64\, some of your TODO tests are passing​:

##### Test Summary Report

../cpan/Module-Metadata/t/extract-version.t (Wstat​: 0 Tests​: 221 Failed​: 0)   TODO passed​: 199\, 202-203\, 206\, 210\, 212-213\, 215 Files=2386\, Tests=731729\, 155 wallclock secs (61.15 usr 6.71 sys + 363.66 cusr 31.62 csys = 463.14 CPU) Result​: PASS #####

-- James E Keenan (jkeenan@​cpan.org)

p5pRT commented 8 years ago

@jkeenan - Status changed from 'open' to 'resolved'

p5pRT commented 8 years ago

From @iabyn

On Thu\, Oct 01\, 2015 at 04​:54​:22PM -0700\, James E Keenan via RT wrote​:

Pushed to blead in commit 0fa1f7e4e66a455cab6ccf1f9c49f2373c1ced80

When I ran make harness on Linux x86_64\, some of your TODO tests are passing​:

##### Test Summary Report ------------------- ../cpan/Module-Metadata/t/extract-version.t (Wstat​: 0 Tests​: 221 Failed​: 0) TODO passed​: 199\, 202-203\, 206\, 210\, 212-213\, 215 Files=2386\, Tests=731729\, 155 wallclock secs (61.15 usr 6.71 sys + 363.66 cusr 31.62 csys = 463.14 CPU) Result​: PASS #####

Karen\, is there any timescale for a new release that "fixes" these annoying TODO successes in blead?

-- Red sky at night - gerroff my land! Red sky at morning - gerroff my land!   -- old farmers' sayings #14

p5pRT commented 8 years ago

From @karenetheridge

That's planned for the next round of refactoring\, after I've fixed the last outstanding issue in the current TRIALs (which I hope to have done Real Soon Now).

Can you clarify how the TODO successes are annoying? Is it tickling a Porting test?

On Tue\, Nov 10\, 2015 at 9​:12 AM\, Dave Mitchell via RT \< perlbug-followup@​perl.org> wrote​:

On Thu\, Oct 01\, 2015 at 04​:54​:22PM -0700\, James E Keenan via RT wrote​:

Pushed to blead in commit 0fa1f7e4e66a455cab6ccf1f9c49f2373c1ced80

When I ran make harness on Linux x86_64\, some of your TODO tests are passing​:

##### Test Summary Report ------------------- ../cpan/Module-Metadata/t/extract-version.t (Wstat​: 0 Tests​: 221 Failed​: 0) TODO passed​: 199\, 202-203\, 206\, 210\, 212-213\, 215 Files=2386\, Tests=731729\, 155 wallclock secs (61.15 usr 6.71 sys + 363.66 cusr 31.62 csys = 463.14 CPU) Result​: PASS #####

Karen\, is there any timescale for a new release that "fixes" these annoying TODO successes in blead?

-- Red sky at night - gerroff my land! Red sky at morning - gerroff my land! -- old farmers' sayings #14

p5pRT commented 8 years ago

From @iabyn

On Tue\, Nov 10\, 2015 at 11​:12​:16AM -0800\, Karen Etheridge wrote​:

Can you clarify how the TODO successes are annoying? Is it tickling a Porting test?

No\, its not breaking anything; it's just that whenever you do a 'make test' on blead\, you get a whole bunch of extra text at the end that looks just like the text you get when one of the test scripts failed\, and you have to look again to confirm that nothing broke.

i.e. this​:

  Test Summary Report   -------------------   ../cpan/Module-Metadata/t/extract-version.t (Wstat​: 0 Tests​: 221 Failed​: 0)   TODO passed​: 199\, 202-203\, 206\, 210\, 212-213\, 215   Files=2386\, Tests=731729\, 155 wallclock secs (61.15 usr 6.71 sys + 363.66 cusr 31.62 csys = 463.14 CPU)   Result​: PASS

looks remarkably similar to​:

  Test Summary Report   -------------------   ../cpan/Module-Metadata/t/extract-version.t (Wstat​: 0 Tests​: 221 Failed​: 8)   Failed tests​:: 199\, 202-203\, 206\, 210\, 212-213\, 215   Files=2386\, Tests=731729\, 155 wallclock secs (61.15 usr 6.71 sys + 363.66 cusr 31.62 csys = 463.14 CPU)   Result​: FAIL

at first glance. Compared with all tests passing\, which is​:

  All tests successful.   Files=2385\, Tests=725471\, 228 wallclock secs (187.25 usr 6.78 sys + 957.47 cusr 35.22 csys = 1186.72 CPU)   Result​: PASS

Similarly when looking at smoke fail reports.

-- The crew of the Enterprise encounter an alien life form which is surprisingly neither humanoid nor made from pure energy.   -- Things That Never Happen in "Star Trek" #22

p5pRT commented 8 years ago

From @bulk88

On Tue Nov 10 13​:29​:37 2015\, davem wrote​:

On Tue\, Nov 10\, 2015 at 11​:12​:16AM -0800\, Karen Etheridge wrote​:

Can you clarify how the TODO successes are annoying? Is it tickling a Porting test?

No\, its not breaking anything; it's just that whenever you do a 'make test' on blead\, you get a whole bunch of extra text at the end that looks just like the text you get when one of the test scripts failed\, and you have to look again to confirm that nothing broke.

I also agree it is annoying and it looks like things failed at first glance.

-- bulk88 ~ bulk88 at hotmail.com