This is an automated email from the git hooks/post-receive script. gregoa pushed a commit to branch master in repository libmodule-info-perl.
commit 491cf7a5147afc6ae6c4131fe02b5cf14232369d Author: gregor herrmann <gre...@debian.org> Date: Wed Oct 21 17:31:02 2015 +0200 Imported Upstream version 0.35.07 --- Build.PL | 13 -- Changes | 39 ++++ MANIFEST | 7 +- META.json | 57 ++---- META.yml | 43 ++-- Makefile.PL | 9 +- README | 19 ++ lib/B/BUtils.pm | 516 ------------------------------------------------ lib/B/Module/Info.pm | 34 +++- lib/Module/Info.pm | 10 +- t/Module-Info.t | 11 +- t/n1_modules_required.t | 1 + t/zy_pod_coverage.t | 7 + 13 files changed, 150 insertions(+), 616 deletions(-) diff --git a/Build.PL b/Build.PL deleted file mode 100644 index ac54ac4..0000000 --- a/Build.PL +++ /dev/null @@ -1,13 +0,0 @@ -require 5.004; - -use strict; -use Module::Build; - -Module::Build->new( module_name => 'Module::Info', - dist_version_from => 'lib/Module/Info.pm', - license => 'perl', - requires => { 'File::Spec' => 0.08 }, - script_files => [qw(bin/pfunc bin/module_info)], - dynamic_config => 0, - dist_author => 'Mattia Barbon <mbar...@cpan.org>', - )->create_build_script; diff --git a/Changes b/Changes index fe8e8dd..a7274e9 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,44 @@ Revision history for perl module Module::Info +0.35_07 2015-10-19 NEILB + - I had missed another instance of "the Windows cwd() issue" affecting + t/n1_modules_required.t + +0.35_06 2015-10-17 NEILB + - Added "use strict" to both modules + - Made the pod coverage test a release test RT#90599 + - Added MIN_PERL_VERSION to Makefile.PL + - Added a basic README + +0.35_05 2015-10-16 NEILB + - Had a single failure reported by CPAN Testers for Perl 5.22/Windows. + On Windows, if you "use Cwd" and then call cwd(), then it does an + implicit "use Win32". On recent perls (sometime after 5.20.1) this + seems to get built into the op tree in a way that looks like the + scope doing the cwd() use'd Win32. There are several magic functions + in Cwd.pm which will probably trigger this behaviour. I'll see how this + change tests out, and possibly just document it for a non dev release. + +0.35_04 2015-10-14 NEILB + - Sigh, forgot to update the min version of B::Utils in Makefile.PL + Thanks to SREZIC for letting me know. + +0.35_03 2015-10-13 NEILB + - Removed File::Spec from t/lib/ + - Set min required version of B::Utils to 0.27, as that release fixes + the remaining failing tests. + - Hacked const_sv() to cope with the change in OP_METHOD_NAMED + that happened at 5.21.5 (or possibly an earlier 5.21.*). + +0.35_02 2015-06-15 NEILB + - Sigh, forgot to add B::Utils to PREREQ_PM + +0.35_01 2015-06-15 NEILB + - Dropped B::BUtils in favour of using the standard B::Utils. + subroutines_called() stopped working correctly for standard function + calls, identifying them as calls via symbolic references. Fixed that. + - Dropped Build.PL + 0.35 2013-09-08 14:10:31 CEST - Handle 'package NAME VERSION' syntax (patch by Norbert Gruener) - Added repository and license info to metadata diff --git a/MANIFEST b/MANIFEST index 691ffe6..a5510f6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,11 +1,9 @@ -Build.PL Changes MANIFEST -META.yml +README Makefile.PL bin/module_info bin/pfunc -lib/B/BUtils.pm lib/B/Module/Info.pm lib/Module/Info.pm t/Module-Info.t @@ -24,4 +22,5 @@ t/n2_safe.t t/n3_version.t t/zy_pod_coverage.t t/zz_pod.t -META.json +META.yml Module YAML meta-data (added by MakeMaker) +META.json Module JSON meta-data (added by MakeMaker) diff --git a/META.json b/META.json index 47fcb27..6118d0c 100644 --- a/META.json +++ b/META.json @@ -4,7 +4,7 @@ "Mattia Barbon <mbar...@cpan.org>" ], "dynamic_config" : 0, - "generated_by" : "Module::Build version 0.4007, CPAN::Meta::Converter version 2.120921", + "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001", "license" : [ "perl_5" ], @@ -13,49 +13,34 @@ "version" : "2" }, "name" : "Module-Info", + "no_index" : { + "directory" : [ + "t", + "inc" + ] + }, "prereqs" : { + "build" : { + "requires" : { + "ExtUtils::MakeMaker" : "0" + } + }, "configure" : { "requires" : { - "Module::Build" : "0.40" + "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { - "File::Spec" : "0.08" + "B" : "0", + "B::Utils" : "0.27", + "Carp" : "0", + "File::Spec" : "0.8", + "perl" : "5.006", + "strict" : "0" } } }, - "provides" : { - "B::BUtils" : { - "file" : "lib/B/BUtils.pm", - "version" : 0 - }, - "B::Module::Info" : { - "file" : "lib/B/Module/Info.pm", - "version" : "0.24" - }, - "B::Utils" : { - "file" : "lib/B/BUtils.pm", - "version" : "0.04_02" - }, - "Module::Info" : { - "file" : "lib/Module/Info.pm", - "version" : "0.35" - }, - "Module::Info::Safe" : { - "file" : "lib/Module/Info.pm", - "version" : 0 - }, - "Module::Info::Unsafe" : { - "file" : "lib/Module/Info.pm", - "version" : 0 - } - }, - "release_status" : "stable", - "resources" : { - "license" : [ - "http://dev.perl.org/licenses/" - ] - }, - "version" : "0.35" + "release_status" : "testing", + "version" : "0.35_07" } diff --git a/META.yml b/META.yml index 01bfe7c..bdefe2d 100644 --- a/META.yml +++ b/META.yml @@ -2,37 +2,26 @@ abstract: 'Information about Perl modules' author: - 'Mattia Barbon <mbar...@cpan.org>' -build_requires: {} +build_requires: + ExtUtils::MakeMaker: '0' configure_requires: - Module::Build: 0.40 + ExtUtils::MakeMaker: '0' dynamic_config: 0 -generated_by: 'Module::Build version 0.4007, CPAN::Meta::Converter version 2.120921' +generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: 1.4 + version: '1.4' name: Module-Info -provides: - B::BUtils: - file: lib/B/BUtils.pm - version: 0 - B::Module::Info: - file: lib/B/Module/Info.pm - version: 0.24 - B::Utils: - file: lib/B/BUtils.pm - version: 0.04_02 - Module::Info: - file: lib/Module/Info.pm - version: 0.35 - Module::Info::Safe: - file: lib/Module/Info.pm - version: 0 - Module::Info::Unsafe: - file: lib/Module/Info.pm - version: 0 +no_index: + directory: + - t + - inc requires: - File::Spec: 0.08 -resources: - license: http://dev.perl.org/licenses/ -version: 0.35 + B: '0' + B::Utils: '0.27' + Carp: '0' + File::Spec: '0.8' + perl: '5.006' + strict: '0' +version: 0.35_07 diff --git a/Makefile.PL b/Makefile.PL index f14b869..23db750 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -33,7 +33,13 @@ WriteMakefile( NAME => $PACKAGE, VERSION_FROM => "lib/$PACKAGE_FILE.pm", # finds $VERSION ABSTRACT_FROM => "lib/$PACKAGE_FILE.pm", - PREREQ_PM => { 'File::Spec' => 0.8 }, + PREREQ_PM => { + 'File::Spec' => 0.8, + 'B' => 0, + 'B::Utils' => 0.27, + 'strict' => 0, + 'Carp' => 0, + }, 'dist' => { COMPRESS => 'gzip -9', SUFFIX => '.gz', DIST_DEFAULT => 'all tardist', @@ -41,6 +47,7 @@ WriteMakefile( EXE_FILES => [qw(bin/pfunc bin/module_info)], PL_FILES => {}, # skip Build.PL ($mmv >= 6.31 ? (LICENSE => 'perl') : ()), + ($mmv >= 6.48 ? (MIN_PERL_VERSION => '5.006') : ()), ( $] >= 5.005 ? ( AUTHOR => 'Mattia Barbon <mbar...@cpan.org>' ) : () ), diff --git a/README b/README new file mode 100644 index 0000000..9eef6ba --- /dev/null +++ b/README @@ -0,0 +1,19 @@ + + README for Perl module Module::Info + +Module::Info can be used to get information other Perl modules, +without loading them into your process. + +You can read a nicely formatted version of the documentation for +this module online: + + https://metacpan.org/pod/Module::Info + +You should be able to install this using your usual method for installing +modules from CPAN. If you don't have one, have a look at: + + http://www.cpan.org/modules/INSTALL.html + +This module was originally written by Michael G Schwern <schw...@pobox.com>. +It was maintained from 2002 to 2013 by Mattia Barbon <mbar...@cpan.org>. +It is currently being maintained by Neil Bowers <ne...@cpan.org>. diff --git a/lib/B/BUtils.pm b/lib/B/BUtils.pm deleted file mode 100644 index 3beeb90..0000000 --- a/lib/B/BUtils.pm +++ /dev/null @@ -1,516 +0,0 @@ -# forked version of B::Utils; needs to merge it ASAP -package B::Utils; - -use 5.006; -use warnings; -use vars '$DEBUG'; -our @EXPORT_OK = qw(all_starts all_roots anon_subs - walkoptree_simple walkoptree_filtered - walkallops_simple walkallops_filtered - carp croak - opgrep - ); -sub import { - my $pack = __PACKAGE__; shift; - my @exports = @_; - my $caller = caller; - my %EOK = map {$_ => 1} @EXPORT_OK; - for (@exports) { - unless ($EOK{$_}) { - require Carp; - Carp::croak(qq{"$_" is not exported by the $pack module}); - } - no strict 'refs'; - *{"$caller\::$_"} = \&{"$pack\::$_"}; - } -} - -our $VERSION = '0.04_02'; # 0.04 with some Schwern patches - -use B qw(main_start main_root walksymtable class OPf_KIDS); - -my (%starts, %roots, @anon_subs); - -our @bad_stashes = qw(B Carp DB Exporter warnings Cwd Config CORE blib strict DynaLoader vars XSLoader AutoLoader base); - -sub null { - my $op = shift; - class( $op ) eq 'NULL'; -} - -{ my $_subsdone=0; -sub _init { # To ensure runtimeness. - return if $_subsdone; - %starts = ( '__MAIN__' => main_start() ); - %roots = ( '__MAIN__' => main_root() ); - walksymtable(\%main::, - '_push_starts', - sub { - return if scalar grep {$_[0] eq $_."::"} @bad_stashes; - 1; - }, # Do not eat our own children! - ''); - push @anon_subs, { root => $_->ROOT, start => $_->START} - for grep { class($_) eq "CV" } B::main_cv->PADLIST->ARRAY->ARRAY; - $_subsdone=1; -} -} - -=head1 NAME - -B::Utils - Helper functions for op tree manipulation - -=head1 SYNOPSIS - - use B::Utils; - -=head1 DESCRIPTION - -These functions make it easier to manipulate the op tree. - -=head1 FUNCTIONS - -=over 3 - -=item C<all_starts> - -=item C<all_roots> - -Returns a hash of all of the starting ops or root ops of optrees, keyed -to subroutine name; the optree for main program is simply keyed to C<__MAIN__>. - -B<Note>: Certain "dangerous" stashes are not scanned for subroutines: -the list of such stashes can be found in C<@B::Utils::bad_stashes>. Feel -free to examine and/or modify this to suit your needs. The intention is -that a simple program which uses no modules other than C<B> and -C<B::Utils> would show no addition symbols. - -This does B<not> return the details of ops in anonymous subroutines -compiled at compile time. For instance, given - - $a = sub { ... }; - -the subroutine will not appear in the hash. This is just as well, since -they're anonymous... If you want to get at them, use... - -=item C<anon_subs()> - -This returns an array of hash references. Each element has the keys -"start" and "root". These are the starting and root ops of all of -the anonymous subroutines in the program. - -=cut - -sub all_starts { _init(); return %starts; } -sub all_roots { _init(); return %roots; } -sub anon_subs { _init(); return @anon_subs } - -sub B::GV::_push_starts { - my $name = $_[0]->STASH->NAME."::".$_[0]->SAFENAME; - return unless ${$_[0]->CV}; - my $cv = $_[0]->CV; - - if ($cv->PADLIST->can("ARRAY") and $cv->PADLIST->ARRAY and $cv->PADLIST->ARRAY->can("ARRAY")) { - push @anon_subs, { root => $_->ROOT, start => $_->START} - for grep { class($_) eq "CV" } $cv->PADLIST->ARRAY->ARRAY; - } - return unless ${$cv->START} and ${$cv->ROOT}; - $starts{$name} = $cv->START; - $roots{$name} = $cv->ROOT; -}; - -sub B::SPECIAL::_push_starts{} - -=item C<< $op->oldname >> - -Returns the name of the op, even if it is currently optimized to null. -This helps you understand the stucture of the op tree. - -=cut - -sub B::OP::oldname { - return substr(B::ppname($_[0]->targ),3) if $_[0]->name eq "null" and $_[0]->targ; - return $_[0]->name; -} - -=item C<< $op->kids >> - -Returns an array of all this op's non-null children, in order. - -=cut - -sub B::OP::kids { - my $op = shift; - my @rv = (); - - foreach my $type (qw(first last other)) { - my $kid = $op->$type(); - next if !$kid || class($kid) eq 'NULL'; - if( $kid->name eq 'null' ) { - push @rv, $kid->kids; - } - else { - push @rv, $kid; - } - } - - my @more_rv = (); - foreach my $more_op (@rv) { - my $next_op = $more_op; - while( $next_op->can("sibling") ) { - $next_op = $next_op->sibling; - last if !$next_op || class($next_op) eq 'NULL'; - if( $next_op->name eq 'null' ) { - push @more_rv, $next_op->kids; - } - else { - push @more_rv, $next_op; - } - } - } - - return @rv, @more_rv; -} - -=item C<< $op->first >> - -=item C<< $op->last >> - -=item C<< $op->other >> - -Normally if you call first, last or other on anything which is not an -UNOP, BINOP or LOGOP respectivly it will die. This leads to lots of -code like: - - $op->first if $op->can('first'); - -B::Utils provides every op with first, last and other methods which -will simply return nothing if it isn't relevent. - -=cut - -foreach my $type (qw(first last other)) { - no strict 'refs'; - *{'B::OP::'.$type} = sub { - my($op) = shift; - if( $op->can("SUPER::$type") ) { - return $op->$type(); - } - else { - return; - } - } -} - -=item C<< $op->parent >> - -Returns the parent node in the op tree, if possible. Currently "possible" means -"if the tree has already been optimized"; that is, if we're during a C<CHECK> -block. (and hence, if we have valid C<next> pointers.) - -In the future, it may be possible to search for the parent before we have the -C<next> pointers in place, but it'll take me a while to figure out how to do -that. - -=cut - -sub B::OP::parent { - my $target = shift; - printf( "parent %s %s=(0x%07x)\n", - B::class( $target), - $target->oldname, - $$target ) - if $DEBUG; - - die "I'm not sure how to do this yet. I'm sure there is a way. If you know, please email me." - if (!$target->seq); - - my (%deadend, $search_kids); - $search_kids = sub { - my $node = shift || return undef; - - printf( "Searching from %s %s=(0x%07x)\n", - class($node)||'?', - $node->oldname, - $$node ) - if $DEBUG; - - # Go up a level if we've got stuck, and search (for the same - # $target) from a higher vantage point. - return $search->($node->parent) if exists $deadend{$node}; - - # Test the immediate children - return $node if scalar grep {$_ == $target} $node->kids; - - # Recurse - my $x; - defined($x = $search->($_)) and return $x for $node->kids; - - # Not in this subtree. - $deadend{$node}++; - return undef; - }; - my $result; - my $start = $target; - $result = $search->($start) and return $result while $start = $start->next; - return $search->($start); -} - -=item C<< $op->previous >> - -Like C<< $op->next >>, but not quite. - -=cut - -sub B::OP::previous { - my $target = shift; - my $start = $target; - my (%deadend, $search); - $search = sub { - my $node = shift || die; - return $search->(find_parent($node)) if exists $deadend{$node}; - return $node if $node->{next}==$target; - # Recurse - my $x; - ($_->next == $target and return $_) for $node->kids; - defined($x = $search->($_)) and return $x for $node->{kids}; - - # Not in this subtree. - $deadend{$node}++; - return undef; - }; - my $result; - $result = $search->($start) and return $result - while $start = $start->next; -} - -=item walkoptree_simple($op, \&callback, [$data]) - -The C<B> module provides various functions to walk the op tree, but -they're all rather difficult to use, requiring you to inject methods -into the C<B::OP> class. This is a very simple op tree walker with -more expected semantics. - -The &callback is called at each op with the op itself passed in as the -first argument and any additional $data as the second. - -All the C<walk> functions set C<$B::Utils::file> and C<$B::Utils::line> -to the appropriate values of file and line number in the program -being examined. Since only COPs contain this information it may be -unavailable in the first few callback calls. - -=cut - -our ($file, $line); - -# Make sure we reset $file and $line between runs. -sub walkoptree_simple { - ($file, $line) = ('__none__', 0); - - _walkoptree_simple(@_); -} - -sub _walkoptree_simple { - my ($op, $callback, $data) = @_; - ($file, $line) = ($op->file, $op->line) if $op->isa("B::COP"); - $callback->($op,$data); - if ($$op && ($op->flags & OPf_KIDS)) { - my $kid; - for ($kid = $op->first; $$kid; $kid = $kid->sibling) { - _walkoptree_simple($kid, $callback, $data); - } - } -} - -=item walkoptree_filtered($op, \&filter, \&callback, [$data]) - -This is much the same as C<walkoptree_simple>, but will only call the -callback if the C<filter> returns true. The C<filter> is passed the -op in question as a parameter; the C<opgrep> function is fantastic -for building your own filters. - -=cut - -sub walkoptree_filtered { - ($file, $line) = ('__none__', 0); - - _walkoptree_filtered(@_); -} - -sub _walkoptree_filtered { - my ($op, $filter, $callback, $data) = @_; - ($file, $line) = ($op->file, $op->line) if $op->isa("B::COP"); - $callback->($op,$data) if $filter->($op); - if ($$op && ($op->flags & OPf_KIDS)) { - my $kid; - for ($kid = $op->first; $$kid; $kid = $kid->sibling) { - _walkoptree_filtered($kid, $filter, $callback, $data); - } - } -} - -=item walkallops_simple(\&callback, [$data]) - -This combines C<walkoptree_simple> with C<all_roots> and C<anon_subs> -to examine every op in the program. C<$B::Utils::sub> is set to the -subroutine name if you're in a subroutine, C<__MAIN__> if you're in -the main program and C<__ANON__> if you're in an anonymous subroutine. - -=cut - -our $sub; - -sub walkallops_simple { - my ($callback, $data) = @_; - _init(); - for $sub (keys %roots) { - walkoptree_simple($roots{$sub}, $callback, $data); - } - $sub = "__ANON__"; - for (@anon_subs) { - walkoptree_simple($_->{root}, $callback, $data); - } -} - -=item walkallops_filtered(\&filter, \&callback, [$data]) - -Same as above, but filtered. - -=cut - -sub walkallops_filtered { - my ($filter, $callback, $data) = @_; - _init(); - for $sub (keys %roots) { - walkoptree_filtered($roots{$sub}, $filter, $callback, $data); - } - $sub = "__ANON__"; - for (@anon_subs) { - walkoptree_filtered($_->{root}, $filter, $callback, $data); - } -} - -=item carp(@args) - -=item croak(@args) - -Warn and die, respectively, from the perspective of the position of the op in -the program. Sounds complicated, but it's exactly the kind of error reporting -you expect when you're grovelling through an op tree. - -=cut - -sub _preparewarn { - my $args = join '', @_; - $args = "Something's wrong " unless $args; - $args .= " at $file line $line.\n" unless substr($args, length($args) -1) eq "\n"; -} - -sub carp (@) { CORE::warn(_preparewarn(@_)) } -sub croak (@) { CORE::die(_preparewarn(@_)) } - -=item opgrep(\%conditions, @ops) - -Returns the ops which meet the given conditions. The conditions should be -specified like this: - - @barewords = opgrep( - { name => "const", private => OPpCONST_BARE }, - @ops - ); - -You can specify alternation by giving an arrayref of values: - - @svs = opgrep ( { name => ["padsv", "gvsv"] }, @ops) - -And you can specify inversion by making the first element of the arrayref -a "!". (Hint: if you want to say "anything", say "not nothing": C<["!"]>) - -You may also specify the conditions to be matched in nearby ops. - - walkallops_filtered( - sub { opgrep( {name => "exec", - next => { - name => "nextstate", - sibling => { name => [qw(! exit warn die)] } - } - }, @_)}, - sub { - carp("Statement unlikely to be reached"); - carp("\t(Maybe you meant system() when you said exec()?)\n"); - } - ) - -Get that? - -Here are the things that can be tested: - - name targ type seq flags private pmflags pmpermflags - first other last sibling next pmreplroot pmreplstart pmnext - -=cut - -sub opgrep { - my ($cref, @ops) = @_; - my %conds = %$cref; - my @rv = (); - - OPLOOP: for my $o (grep defined, @ops) { - # First, let's skim off ops of the wrong type. - for my $type (qw(first other last pmreplroot pmreplstart pmnext pmflags pmpermflags)) { - next OPLOOP if exists $conds{$type} and !$o->can($type); - } - - for my $test (qw(name targ type seq flags private pmflags pmpermflags)) { - next unless exists $conds{$test}; - next OPLOOP unless $o->can($test); - - my @conds = ref $conds{$test} ? @{$conds{$test}} : $conds{$test}; - - if ($conds[0] eq "!") { - my @conds = @{$conds{$test}}; shift @conds; - next OPLOOP if grep {$o->$test eq $_} @conds; - } else { - next OPLOOP unless grep {$o->$test eq $_} @conds; - } - } - - for my $neighbour (qw(first other last sibling next pmreplroot pmreplstart pmnext)) { - next unless exists $conds{$neighbour}; - # We know it can, because we tested that above - # Recurse, recurse! - next OPLOOP unless opgrep($conds{$neighbour}, $o->$neighbour); - } - - push @rv, $o; - } - return @rv; -} - -package B::BUtils; - -@ISA = qw(B::Utils); - -1; - -=back - -=head2 EXPORT - -None by default. - -=head1 AUTHOR - -Simon Cozens, C<si...@cpan.org> - -=head1 TODO - -I need to add more Fun Things, and possibly clean up some parts where -the (previous/parent) algorithm has catastrophic cases, but it's more -important to get this out right now than get it right. - -=head1 SEE ALSO - -L<B>, L<B::Generate>. - -=cut diff --git a/lib/B/Module/Info.pm b/lib/B/Module/Info.pm index 805ea79..067e4cd 100644 --- a/lib/B/Module/Info.pm +++ b/lib/B/Module/Info.pm @@ -1,11 +1,14 @@ package B::Module::Info; -$VERSION = '0.24'; +use 5.006; +use strict; +our $VERSION = '0.35_07'; use B; -use B::BUtils qw(walkoptree_filtered walkoptree_simple - opgrep all_roots); +use B::Utils 0.27 qw(walkoptree_filtered walkoptree_simple + opgrep all_roots); @B::Utils::bad_stashes = qw(); # give us everything. +our ($Start, $End, $File, $CurCV); =head1 NAME @@ -185,9 +188,16 @@ my %modes = ( sub const_sv { my $op = shift; - my $sv = $op->sv if $op->can('sv'); + my $sv; + + if ($op->name eq 'method_named' && $op->can('meth_sv')) { + $sv = $op->meth_sv; + } + elsif ($op->can('sv')) { + $sv = $op->sv; + } # the constant could be in the pad (under useithreads) - $sv = padval($op->targ) unless $$sv; + $sv = padval($op->targ) unless ref($sv) && $$sv; return $sv; } @@ -401,15 +411,19 @@ sub sub_check { } # function call else { - my($name_op) = grep($_->name eq 'gv', @kids); - if( $name_op ) { - my $gv = gv_or_padgv($name_op); + my $gv_op; + my ($filename, $line) = ($B::Utils::file, $B::Utils::line); + walkoptree_simple($op, + sub { my $op = shift; $gv_op = $op if $op->name eq 'gv'; } + ); + if ($gv_op) { + my $gv = gv_or_padgv($gv_op); printf "function call to %s at \"%s\" line %d\n", - $gv->NAME, $B::Utils::file, $B::Utils::line; + $gv->NAME, $filename, $line; } else { printf "function call using symbolic ref at \"%s\" line %d\n", - $B::Utils::file, $B::Utils::line; + $filename, $line; } } } diff --git a/lib/Module/Info.pm b/lib/Module/Info.pm index b17abe4..6af8416 100644 --- a/lib/Module/Info.pm +++ b/lib/Module/Info.pm @@ -1,16 +1,18 @@ package Module::Info; +use 5.006; use strict; +use warnings; use Carp; use File::Spec; use Config; -require 5.004; my $has_version_pm = eval 'use version; 1'; -use vars qw($VERSION @ISA $AUTOLOAD); -# quotes 'version' for 5.004 -$VERSION = eval 'use version; 1' ? 'version'->new('0.35') : '0.35'; +our $AUTOLOAD; +our $VERSION; + +$VERSION = eval 'use version; 1' ? 'version'->new('0.35_07') : '0.35_07'; $VERSION = eval $VERSION; diff --git a/t/Module-Info.t b/t/Module-Info.t index f0ddaec..a1d88c8 100644 --- a/t/Module-Info.t +++ b/t/Module-Info.t @@ -6,11 +6,11 @@ use Config; my $has_version_pm = eval 'use version; 1'; my $version_pm_VERSION = $has_version_pm ? 'version'->VERSION : 0; -my $Mod_Info_VERSION = '0.35'; +my $Mod_Info_VERSION = '0.35_07'; # 0.280 vith version.pm, 0.28 without, except for development versions -my $Mod_Info_Pack_VERSION = !$has_version_pm ? '0.35' : # 0.3101 - $has_version_pm && $version_pm_VERSION > '0.72' ? '0.35' : # 0.3101 - '0.35'; # 0.310001 +my $Mod_Info_Pack_VERSION = !$has_version_pm ? '0.3507' : # 0.3101 + $has_version_pm && $version_pm_VERSION > '0.72' ? '0.3507' : # 0.3101 + '0.350007'; # 0.310001 my @old5lib = defined $ENV{PERL5LIB} ? ($ENV{PERL5LIB}) : (); $ENV{PERL5LIB} = join $Config{path_sep}, 'blib/lib', @old5lib; @@ -95,7 +95,7 @@ SKIP: { my @mods = $mod_info->modules_used; my @expected = qw(strict File::Spec Config - Carp IPC::Open3 vars Safe); + Carp IPC::Open3 warnings Safe); push @expected, 'Exporter' if grep /^Exporter$/, @mods; # many old versions of these modules loaded the Exporter: is( @mods, @expected, 'Found all modules used' ); @@ -299,6 +299,7 @@ SKIP: { $module = Module::Info->new_from_file('t/lib/Bar.pm'); @mods = $module->modules_used; + @mods = grep { $_ ne 'Win32' } @mods if $^O eq 'MSWin32'; is( @mods, 3, 'modules_used with complex BEGIN block' ); is_deeply( [sort @mods], [sort qw(Cwd Carp strict)] ); diff --git a/t/n1_modules_required.t b/t/n1_modules_required.t index 9783d96..bb32699 100644 --- a/t/n1_modules_required.t +++ b/t/n1_modules_required.t @@ -11,6 +11,7 @@ SKIP: { skip "Only works on 5.6.1 and up.", 3 unless $] >= 5.006001; my %mods = $bar->modules_required; + delete $mods{Win32} if $^O eq 'MSWin32'; is_deeply( [ sort keys %mods ], [ sort qw(Cwd strict Carp) ], "Got the correct modules" ); diff --git a/t/zy_pod_coverage.t b/t/zy_pod_coverage.t index 03d3227..465af57 100644 --- a/t/zy_pod_coverage.t +++ b/t/zy_pod_coverage.t @@ -1,5 +1,12 @@ #!/usr/bin/perl -w +BEGIN { + unless ($ENV{RELEASE_TESTING}) { + require Test::More; + Test::More::plan(skip_all => 'these tests are for release candidate testing'); + } +} + use strict; use Test::More; eval "use Test::Pod::Coverage 1.00"; -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libmodule-info-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits