[libmodule-info-perl] 01/07: Imported Upstream version 0.35.07
gregor herrmann
gregoa at debian.org
Wed Oct 21 15:42:39 UTC 2015
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 <gregoa at 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 <mbarbon at 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 <mbarbon at 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 <mbarbon at 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 <mbarbon at 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 <schwern at pobox.com>.
+It was maintained from 2002 to 2013 by Mattia Barbon <mbarbon at cpan.org>.
+It is currently being maintained by Neil Bowers <neilb at 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;
-
- at ISA = qw(B::Utils);
-
-1;
-
-=back
-
-=head2 EXPORT
-
-None by default.
-
-=head1 AUTHOR
-
-Simon Cozens, C<simon at 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
More information about the Pkg-perl-cvs-commits
mailing list