r67448 - in /trunk/libtest-module-used-perl: ./ debian/ inc/Module/ inc/Module/Install/ lib/Test/Module/ t/ testdata/
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Sun Jan 16 21:53:02 UTC 2011
Author: periapt-guest
Date: Sun Jan 16 21:52:55 2011
New Revision: 67448
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=67448
Log:
New upstream release
Added:
trunk/libtest-module-used-perl/t/011_read_meta_json.t
- copied unchanged from r67447, branches/upstream/libtest-module-used-perl/current/t/011_read_meta_json.t
trunk/libtest-module-used-perl/t/012_used_ok.t
- copied unchanged from r67447, branches/upstream/libtest-module-used-perl/current/t/012_used_ok.t
trunk/libtest-module-used-perl/t/013_requires_ok.t
- copied unchanged from r67447, branches/upstream/libtest-module-used-perl/current/t/013_requires_ok.t
trunk/libtest-module-used-perl/t/014_requires_ok_fail.t
- copied unchanged from r67447, branches/upstream/libtest-module-used-perl/current/t/014_requires_ok_fail.t
trunk/libtest-module-used-perl/t/015_used_ok_fail.t
- copied unchanged from r67447, branches/upstream/libtest-module-used-perl/current/t/015_used_ok_fail.t
trunk/libtest-module-used-perl/t/016_ok_fail1.t
- copied unchanged from r67447, branches/upstream/libtest-module-used-perl/current/t/016_ok_fail1.t
trunk/libtest-module-used-perl/t/017_ok_fail2.t
- copied unchanged from r67447, branches/upstream/libtest-module-used-perl/current/t/017_ok_fail2.t
trunk/libtest-module-used-perl/testdata/META.json
- copied unchanged from r67447, branches/upstream/libtest-module-used-perl/current/testdata/META.json
trunk/libtest-module-used-perl/testdata/META.yml4
- copied unchanged from r67447, branches/upstream/libtest-module-used-perl/current/testdata/META.yml4
trunk/libtest-module-used-perl/testdata/META.yml5
- copied unchanged from r67447, branches/upstream/libtest-module-used-perl/current/testdata/META.yml5
Modified:
trunk/libtest-module-used-perl/Changes
trunk/libtest-module-used-perl/MANIFEST
trunk/libtest-module-used-perl/META.yml
trunk/libtest-module-used-perl/Makefile.PL
trunk/libtest-module-used-perl/debian/changelog
trunk/libtest-module-used-perl/inc/Module/Install.pm
trunk/libtest-module-used-perl/inc/Module/Install/Base.pm
trunk/libtest-module-used-perl/inc/Module/Install/Can.pm
trunk/libtest-module-used-perl/inc/Module/Install/Fetch.pm
trunk/libtest-module-used-perl/inc/Module/Install/Makefile.pm
trunk/libtest-module-used-perl/inc/Module/Install/Metadata.pm
trunk/libtest-module-used-perl/inc/Module/Install/Win32.pm
trunk/libtest-module-used-perl/inc/Module/Install/WriteAll.pm
trunk/libtest-module-used-perl/lib/Test/Module/Used.pm
trunk/libtest-module-used-perl/t/006_read_meta_yml.t
Modified: trunk/libtest-module-used-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/Changes?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/Changes (original)
+++ trunk/libtest-module-used-perl/Changes Sun Jan 16 21:52:55 2011
@@ -1,3 +1,18 @@
+0.2.2
+ - version++
+ - update year in copyright
+ (no other changes from 0.2.1_04)
+0.2.1_04
+ - add tests
+ - refactorings
+0.2.1_03
+ - implement used_ok() and requires_ok()
+
+0.2.1_02
+ - fix: forget to use Carp
+
+0.2.1_01
+ - META.json support
0.2.0
- add AuthorRequires
- uniquify module lists
@@ -6,14 +21,14 @@
- fix: modules used in test_lib_dir are ignored.(RT#54187)
- ChangeLog format change(Because ShipIt doesn't support previous format)
-0.1.8
+0.1.8
- remove executable permission in Makefile.PL
0.1.7
- add repository in Makefile.PL
(merge from git://github.com/cpanservice/Test-Module-Used.git)
-
+
0.1.6
- fix: add copyright information(for RT#53290)
@@ -65,7 +80,7 @@
0.0.4
- found bug in ok(module_requires exclude)
add build_requires and requires exclusion in constructor
-
+
0.0.3
- add ChangeLog and README
- describe about perl_version
Modified: trunk/libtest-module-used-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/MANIFEST?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/MANIFEST (original)
+++ trunk/libtest-module-used-perl/MANIFEST Sun Jan 16 21:52:55 2011
@@ -24,11 +24,21 @@
t/008_test_is_empty.t
t/009_auto_get_exclude.t
t/010_test_myself2.t
+t/011_read_meta_json.t
+t/012_used_ok.t
+t/013_requires_ok.t
+t/014_requires_ok_fail.t
+t/015_used_ok_fail.t
+t/016_ok_fail1.t
+t/017_ok_fail2.t
testdata/lib/SampleModule.pm
testdata/lib2/My/Test.pm
+testdata/META.json
testdata/META.yml
testdata/META.yml2
testdata/META.yml3
+testdata/META.yml4
+testdata/META.yml5
testdata/t/001_test.t
testdata/t2/001_use_ok.t
testdata/t2/lib/My/Test2.pm
Modified: trunk/libtest-module-used-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/META.yml?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/META.yml (original)
+++ trunk/libtest-module-used-perl/META.yml Sun Jan 16 21:52:55 2011
@@ -4,11 +4,12 @@
- 'Takuya Tsuchida tsucchi at cpan.org'
build_requires:
ExtUtils::MakeMaker: 6.42
+ Test::Builder::Tester: 0
Test::More: 0
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.97'
+generated_by: 'Module::Install version 1.00'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -21,14 +22,14 @@
- testdata
- xt
requires:
+ CPAN::Meta: 0
List::MoreUtils: 0
Module::CoreList: 0
Module::Used: 0
PPI::Document: 0
- YAML: 0
perl: 5.8.0
version: 0.77
resources:
license: http://dev.perl.org/licenses/
repository: http://github.com/tsucchi/Test-Module-Used
-version: 0.2.0
+version: 0.2.2
Modified: trunk/libtest-module-used-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/Makefile.PL?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/Makefile.PL (original)
+++ trunk/libtest-module-used-perl/Makefile.PL Sun Jan 16 21:52:55 2011
@@ -4,12 +4,13 @@
license 'perl';
all_from 'lib/Test/Module/Used.pm';
requires 'Module::Used';
-requires 'YAML';
+requires 'CPAN::Meta';
requires 'List::MoreUtils';
requires 'Module::CoreList';
requires 'PPI::Document';
requires 'version' => 0.77;
test_requires 'Test::More';
+test_requires 'Test::Builder::Tester';
author_tests 'xt';
Modified: trunk/libtest-module-used-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/debian/changelog?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/debian/changelog (original)
+++ trunk/libtest-module-used-perl/debian/changelog Sun Jan 16 21:52:55 2011
@@ -1,12 +1,13 @@
-libtest-module-used-perl (0.2.0-2) UNRELEASED; urgency=low
+libtest-module-used-perl (0.2.2-1) UNRELEASED; urgency=low
[ Ansgar Burchardt ]
* Update my email address.
[ Nicholas Bamber ]
* Added myself to Uploaders
+ * New upstream release
- -- Ansgar Burchardt <ansgar at debian.org> Mon, 01 Nov 2010 11:17:28 +0100
+ -- Nicholas Bamber <nicholas at periapt.co.uk> Sun, 16 Jan 2011 21:55:31 +0000
libtest-module-used-perl (0.2.0-1) unstable; urgency=low
Modified: trunk/libtest-module-used-perl/inc/Module/Install.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/inc/Module/Install.pm?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/inc/Module/Install.pm (original)
+++ trunk/libtest-module-used-perl/inc/Module/Install.pm Sun Jan 16 21:52:55 2011
@@ -22,7 +22,6 @@
use Cwd ();
use File::Find ();
use File::Path ();
-use FindBin;
use vars qw{$VERSION $MAIN};
BEGIN {
@@ -32,7 +31,7 @@
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.97';
+ $VERSION = '1.00';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -231,7 +230,12 @@
sub new {
my ($class, %args) = @_;
- FindBin->again;
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
Modified: trunk/libtest-module-used-perl/inc/Module/Install/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/inc/Module/Install/Base.pm?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/inc/Module/Install/Base.pm (original)
+++ trunk/libtest-module-used-perl/inc/Module/Install/Base.pm Sun Jan 16 21:52:55 2011
@@ -4,7 +4,7 @@
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
}
# Suspend handler for "redefined" warnings
Modified: trunk/libtest-module-used-perl/inc/Module/Install/Can.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/inc/Module/Install/Can.pm?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/inc/Module/Install/Can.pm (original)
+++ trunk/libtest-module-used-perl/inc/Module/Install/Can.pm Sun Jan 16 21:52:55 2011
@@ -9,7 +9,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: trunk/libtest-module-used-perl/inc/Module/Install/Fetch.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/inc/Module/Install/Fetch.pm?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/inc/Module/Install/Fetch.pm (original)
+++ trunk/libtest-module-used-perl/inc/Module/Install/Fetch.pm Sun Jan 16 21:52:55 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: trunk/libtest-module-used-perl/inc/Module/Install/Makefile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/inc/Module/Install/Makefile.pm?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/inc/Module/Install/Makefile.pm (original)
+++ trunk/libtest-module-used-perl/inc/Module/Install/Makefile.pm Sun Jan 16 21:52:55 2011
@@ -4,10 +4,11 @@
use strict 'vars';
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -364,9 +365,9 @@
. ($self->postamble || '');
local *MAKEFILE;
- open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
my $makefile = do { local $/; <MAKEFILE> };
- close MAKEFILE or die $!;
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
@@ -386,7 +387,8 @@
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
- open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
@@ -410,4 +412,4 @@
__END__
-#line 539
+#line 541
Modified: trunk/libtest-module-used-perl/inc/Module/Install/Metadata.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/inc/Module/Install/Metadata.pm?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/inc/Module/Install/Metadata.pm (original)
+++ trunk/libtest-module-used-perl/inc/Module/Install/Metadata.pm Sun Jan 16 21:52:55 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -616,8 +616,15 @@
return $v;
}
-
-
+sub add_metadata {
+ my $self = shift;
+ my %hash = @_;
+ for my $key (keys %hash) {
+ warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+ "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+ $self->{values}->{$key} = $hash{$key};
+ }
+}
######################################################################
Modified: trunk/libtest-module-used-perl/inc/Module/Install/Win32.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/inc/Module/Install/Win32.pm?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/inc/Module/Install/Win32.pm (original)
+++ trunk/libtest-module-used-perl/inc/Module/Install/Win32.pm Sun Jan 16 21:52:55 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
Modified: trunk/libtest-module-used-perl/inc/Module/Install/WriteAll.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/inc/Module/Install/WriteAll.pm?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/inc/Module/Install/WriteAll.pm (original)
+++ trunk/libtest-module-used-perl/inc/Module/Install/WriteAll.pm Sun Jan 16 21:52:55 2011
@@ -6,7 +6,7 @@
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.97';;
+ $VERSION = '1.00';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
Modified: trunk/libtest-module-used-perl/lib/Test/Module/Used.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/lib/Test/Module/Used.pm?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/lib/Test/Module/Used.pm (original)
+++ trunk/libtest-module-used-perl/lib/Test/Module/Used.pm Sun Jan 16 21:52:55 2011
@@ -6,14 +6,14 @@
use File::Spec::Functions qw(catfile);
use Module::Used qw(modules_used_in_document);
use Module::CoreList;
-use YAML;
use Test::Builder;
-use List::MoreUtils qw(any uniq);
+use List::MoreUtils qw(any uniq all);
use PPI::Document;
use version;
-
+use CPAN::Meta;
+use Carp;
use 5.008;
-our $VERSION = '0.2.0';
+our $VERSION = '0.2.2';
=head1 NAME
@@ -72,7 +72,9 @@
test_dir => ['t'], # directory(ies) which contains test scripts.
lib_dir => ['lib'], # directory(ies) which contains module libs.
test_lib_dir => ['t'], # directory(ies) which contains libs used ONLY in test (ex. MockObject for test)
- meta_file => 'META.yml', # META.yml (contains module requirement information)
+ meta_file => 'META.json' or
+ 'META.yml' or
+ 'META.yaml', # META file (YAML or JSON which contains module requirement information)
perl_version => '5.008', # expected perl version which is used for ignore core-modules in testing
exclude_in_testdir => [], # ignored module(s) for test even if it is used.
exclude_in_libdir => [], # ignored module(s) for your lib even if it is used.
@@ -80,7 +82,7 @@
exclude_in_requires => [], # ignored module(s) even if it is written in requires of META.yml.
);
-if perl_version is not passed in constructor, this modules reads I<meta_file> and get perl version.
+if perl_version is not passed in constructor, this modules reads I<meta_file> and get perl version.
I<exclude_in_testdir> is automatically set by default. This module reads I<lib_dir> and parse "pacakge" statement, then found "package" statements and myself(Test::Module::Used) is set.
I<exclude_in_libdir> is also automatically set by default. This module reads I<lib_dir> and parse "package" statement, found "package" statement are set.(Test::Module::Used isnt included)
@@ -94,7 +96,7 @@
test_dir => $opt{test_dir} || ['t'],
lib_dir => $opt{lib_dir} || ['lib'],
test_lib_dir => $opt{test_lib_dir} || ['t'],
- meta_file => $opt{meta_file} || 'META.yml',
+ meta_file => _find_meta_file($opt{meta_file}),
perl_version => $opt{perl_version},
exclude_in_testdir => $opt{exclude_in_testdir},
exclude_in_libdir => $opt{exclude_in_libdir},
@@ -106,6 +108,15 @@
return $self;
}
+sub _find_meta_file {
+ my ($opt_meta_file) = @_;
+ return $opt_meta_file if ( defined $opt_meta_file );
+ for my $file ( qw(META.json META.yml META.yaml) ) {
+ return $file if ( -e $file );
+ }
+ croak "META file not found\n";
+}
+
sub _test_dir {
return shift->{test_dir};
@@ -127,9 +138,9 @@
return shift->{perl_version};
}
-=head2 ok
-
-check used module is ok.
+=head2 ok()
+
+check used modules are required in META file and required modules in META files are used.
my $used = Test::Module::Used->new(
exclude_in_testdir => ['Test::Module::Used', 'My::Module'],
@@ -139,32 +150,123 @@
First, This module reads I<META.yml> and get I<build_requires> and I<requires>. Next, reads module directory (by default I<lib>) and test directory(by default I<t>), and compare required module is really used and used module is really required. If all these requirement information is OK, test will success.
+It is NOT allowed to call ok(), used_ok() and requires_ok() in same test file.
+
=cut
sub ok {
my $self = shift;
+ return $self->_ok(\&_num_tests, \&_used_ok, \&_requires_ok);
+}
+
+=head2 used_ok()
+
+Only check used modules are required in META file.
+Test will success if unused I<requires> or I<build_requires> are defined.
+
+ my $used = Test::Module::Used->new();
+ $used->used_ok;
+
+
+It is NOT allowed to call ok(), used_ok() and requires_ok() in same test file.
+
+=cut
+
+sub used_ok {
+ my $self = shift;
+ return $self->_ok(\&_num_tests_used_ok, \&_used_ok);
+}
+
+=head2 requires_ok()
+
+Only check required modules in META file is used.
+Test will success if used modules are not defined in META file.
+
+ my $used = Test::Module::Used->new();
+ $used->requires_ok;
+
+
+It is NOT allowed to call ok(), used_ok() and requires_ok() in same test file.
+
+=cut
+
+sub requires_ok {
+ my $self = shift;
+ return $self->_ok(\&_num_tests_requires_ok, \&_requires_ok);
+}
+
+sub _ok {
+ my $self = shift;
+ my ($num_tests_subref, @ok_subrefs) = @_;
+
+ croak('Already tested. Calling ok(), used_ok() and requires_ok() in same test file is not allowed') if ( !!$self->{tested} );
+
+ my $num_tests = $num_tests_subref->($self);
+ return $self->_do_test($num_tests, @ok_subrefs);
+}
+
+sub _do_test {
+ my $self = shift;
+ my ($num_tests, @ok_subrefs) = @_;
+
my $test = Test::Builder->new();
-
-
- my $num_tests = $self->_num_tests();
- if ( $num_tests > 0 ) {
- $test->plan(tests => $num_tests);
- my $status_requires_ok = $self->_requires_ok($test,
- [$self->_remove_core($self->_used_modules)],
- [$self->_remove_core($self->_requires)],
- "lib");
- my $status_build_requires_ok = $self->_requires_ok($test,
- [$self->_remove_core($self->_used_modules_in_test)],
- [$self->_remove_core($self->_build_requires)],
- "test");
- return $status_requires_ok && $status_build_requires_ok;
- }
- else {
- $test->plan(tests => 1);
- $test->ok(1, "no tests run");
- return 1;
- }
-}
+ my $test_status = $num_tests > 0 ? $self->_do_test_normal($num_tests, @ok_subrefs) :
+ $self->_do_test_no_tests();
+ $self->{tested} = 1;
+ return !!$test_status;
+}
+
+sub _do_test_normal {
+ my $self = shift;
+ my ($num_tests, @ok_subrefs) = @_;
+
+ my $test = Test::Builder->new();
+ $test->plan(tests => $num_tests);
+ my @status;
+ for my $ok_subref ( @ok_subrefs ) {
+ push(@status, $ok_subref->($self, $test));
+ }
+ my $test_status = all { $_ } @status;
+ return !!$test_status;
+}
+
+sub _do_test_no_tests {
+ my $self = shift;
+
+ my $test = Test::Builder->new();
+ $test->plan(tests => 1);
+ $test->ok(1, "no tests run");
+ return 1;
+}
+
+sub _used_ok {
+ my $self = shift;
+ my ($test) = @_;
+ my $status_lib = $self->_check_used_but_not_required($test,
+ [$self->_remove_core($self->_used_modules)],
+ [$self->_remove_core($self->_requires)],
+ "lib");
+ my $status_test = $self->_check_used_but_not_required($test,
+ [$self->_remove_core($self->_used_modules_in_test)],
+ [$self->_remove_core($self->_build_requires)],
+ "test");
+ return $status_lib && $status_test;
+}
+
+sub _requires_ok {
+ my $self = shift;
+ my ($test) = @_;
+ my $status_lib = $self->_check_required_but_not_used($test,
+ [$self->_remove_core($self->_used_modules)],
+ [$self->_remove_core($self->_requires)],
+ "lib");
+ my $status_test = $self->_check_required_but_not_used($test,
+ [$self->_remove_core($self->_used_modules_in_test)],
+ [$self->_remove_core($self->_build_requires)],
+ "test");
+ return $status_lib && $status_test;
+}
+
=head2 push_exclude_in_libdir( @exclude_module_names )
@@ -216,36 +318,34 @@
sub _num_tests {
my $self = shift;
-
+ return $self->_num_tests_used_ok() + $self->_num_tests_requires_ok();
+}
+
+sub _num_tests_used_ok {
+ my $self = shift;
return scalar($self->_remove_core($self->_used_modules,
- $self->_requires,
- $self->_used_modules_in_test,
+ $self->_used_modules_in_test));
+}
+
+sub _num_tests_requires_ok {
+ my $self = shift;
+ return scalar($self->_remove_core($self->_requires,
$self->_build_requires));
-}
-
-sub _requires_ok {
+
+}
+
+sub _check_required_but_not_used {
my $self = shift;
my ($test, $used_aref, $requires_aref, $place) = @_;
-
- my $status1 = $self->_check_required_but_not_used($test, $requires_aref, $used_aref, $place);
- my $status2 = $self->_check_used_but_not_required($test, $requires_aref, $used_aref, $place);
-
- return $status1 && $status2;
-}
-
-
-sub _check_required_but_not_used {
- my $self = shift;
- my ($test, $requires_aref, $used_aref, $place) = @_;
my @requires = @{$requires_aref};
my @used = @{$used_aref};
my $result = 1;
- for my $require ( @requires ) {
- my $status = any { $_ eq $require } @used;
- $test->ok( $status, "check required module: $require" );
+ for my $requires ( @requires ) {
+ my $status = any { $_ eq $requires } @used;
+ $test->ok( $status, "check required module: $requires" );
if ( !$status ) {
- $test->diag("module $require is required but not used in $place");
+ $test->diag("module $requires is required in META file but not used in $place");
$result = 0;
}
}
@@ -254,7 +354,7 @@
sub _check_used_but_not_required {
my $self = shift;
- my ($test, $requires_aref, $used_aref, $place) = @_;
+ my ($test, $used_aref, $requires_aref, $place) = @_;
my @requires = @{$requires_aref};
my @used = @{$used_aref};
@@ -357,19 +457,21 @@
return defined $first_release && $first_release <= $self->_version;
}
-sub _read_meta_yml {
- my $self = shift;
- my $yaml = YAML::LoadFile( $self->_meta_file );
- $self->{build_requires} = $yaml->{build_requires};
- $self->{version_from_meta} = version->parse($yaml->{requires}->{perl})->numify() if defined $yaml->{requires}->{perl};
- delete $yaml->{requires}->{perl};
- $self->{requires} = $yaml->{requires};
+sub _read_meta {
+ my $self = shift;
+ my $meta = CPAN::Meta->load_file( $self->_meta_file );
+ my $prereqs = $meta->prereqs();
+ $self->{build_requires} = $prereqs->{build}->{requires};
+ my $requires = $prereqs->{runtime}->{requires};
+ $self->{version_from_meta} = version->parse($requires->{perl})->numify() if defined $requires->{perl};
+ delete $requires->{perl};
+ $self->{requires} = $requires;
}
sub _build_requires {
my $self = shift;
- $self->_read_meta_yml if !defined $self->{build_requires};
+ $self->_read_meta if !defined $self->{build_requires};
my @result = sort keys %{$self->{build_requires}};
return _array_difference(\@result, $self->{exclude_in_build_requires});
}
@@ -377,7 +479,7 @@
sub _requires {
my $self = shift;
- $self->_read_meta_yml if !defined $self->{requires};
+ $self->_read_meta if !defined $self->{requires};
my @result = sort keys %{$self->{requires}};
return _array_difference(\@result, $self->{exclude_in_requires});
}
@@ -406,20 +508,39 @@
sub _packages_in_file {
my $self = shift;
my ( $filename ) = @_;
+ my @ppi_package_statements = $self->_ppi_package_statements($filename);
+ my @result;
+ for my $ppi_package_statement ( @ppi_package_statements ) {
+ push @result, $self->_package_names_in($ppi_package_statement);
+ }
+ return @result;
+}
+
+sub _ppi_package_statements {
+ my $self = shift;
+ my ($filename) = @_;
my $doc = $self->_ppi_for($filename);
my $packages = $doc->find('PPI::Statement::Package');
return if ( $packages eq '' );
-
+ return @{ $packages };
+}
+
+sub _package_names_in {
+ my $self = shift;
+ my ($ppi_package_statement) = @_;
my @result;
- for my $item ( @{$packages} ) {
- for my $token ( @{$item->{children}} ) {
- next if ( !$token->isa('PPI::Token::Word') );
- next if ( $token->content eq 'package' );
- push @result, $token->content;
- }
+ for my $token ( @{$ppi_package_statement->{children}} ) {
+ next if ( !$self->_is_package_name($token) );
+ push @result, $token->content;
}
return @result;
+}
+
+sub _is_package_name {
+ my $self = shift;
+ my ($ppi_token) = @_;
+ return $ppi_token->isa('PPI::Token::Word') && $ppi_token->content ne 'package';
}
# PPI::Document object for $filename
@@ -452,7 +573,7 @@
=head1 COPYRIGHT AND LICENSE
-Copyright (c) 2008-2010 Takuya Tsuchida
+Copyright (c) 2008-2011 Takuya Tsuchida
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
Modified: trunk/libtest-module-used-perl/t/006_read_meta_yml.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libtest-module-used-perl/t/006_read_meta_yml.t?rev=67448&op=diff
==============================================================================
--- trunk/libtest-module-used-perl/t/006_read_meta_yml.t (original)
+++ trunk/libtest-module-used-perl/t/006_read_meta_yml.t Sun Jan 16 21:52:55 2011
@@ -8,7 +8,7 @@
my $used = Test::Module::Used->new(
meta_file => catfile('testdata', 'META.yml'),
);
-$used->_read_meta_yml();
+$used->_read_meta();
is_deeply( [$used->_build_requires()],
['ExtUtils::MakeMaker', 'Test::More'] );
@@ -20,7 +20,7 @@
my $used2 = Test::Module::Used->new(
meta_file => catfile('testdata', 'META.yml2'),
);
-$used2->_read_meta_yml();
+$used2->_read_meta();
is_deeply( [$used2->_build_requires()],
['ExtUtils::MakeMaker', 'Test::Class', 'Test::More' ] );
@@ -34,7 +34,7 @@
exclude_in_build_requires => ['Test::Class'],
exclude_in_requires => ['Module::Used'],
);
-$used3->_read_meta_yml();
+$used3->_read_meta();
is_deeply( [$used3->_build_requires()],
['ExtUtils::MakeMaker', 'Test::More' ] );
More information about the Pkg-perl-cvs-commits
mailing list