Test-Exports-1000755001751001751 011502564536 13265 5ustar00mauzousers000000000000Test-Exports-1/META.yml000444001751001751 131211502564536 14670 0ustar00mauzousers000000000000--- abstract: 'Test that modules export the right symbols' author: - 'Ben Morrow ' build_requires: Test::More: 0.65 Test::Most: 0.23 Test::Tester: 0.08 configure_requires: Module::Build: 0.36 generated_by: 'Module::Build version 0.3607' license: bsd meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Test-Exports provides: Test::Exports: file: lib/Test/Exports.pm version: 1 requires: B: 0 Test::Builder: 0 parent: 0 resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Test-Exports license: http://opensource.org/licenses/bsd-license.php repository: http://github.com/mauzo/Test-Exports version: 1 Test-Exports-1/Changes000444001751001751 23411502564536 14674 0ustar00mauzousers000000000000Revision history for Test::Exports 1 2010-12-17 - Initial version, pulled out of the test code for Exporter::NoWork since I need it elsewhere. Test-Exports-1/MANIFEST000444001751001751 21111502564536 14525 0ustar00mauzousers000000000000Build.PL Changes lib/Test/Exports.pm MANIFEST This list of files META.yml README t/00use.t t/01new_import_pkg.t t/exports.t t/import.t Test-Exports-1/Build.PL000444001751001751 117611502564536 14723 0ustar00mauzousers000000000000use Module::Build; Module::Build->new( module_name => "Test::Exports", license => "bsd", requires => { "Test::Builder" => 0, "B" => 0, "parent" => 0, }, build_requires => { "Test::Tester" => "0.08", "Test::More" => "0.65", "Test::Most" => "0.23", }, meta_merge => { resources => { repository => "http://github.com/mauzo/Test-Exports", bugtracker => "https://rt.cpan.org/Public/Dist/Display.html?Name=Test-Exports", }, }, )->create_build_script; Test-Exports-1/README000444001751001751 107011502564536 14300 0ustar00mauzousers000000000000NAME Test::Exports A Perl module for testing modules' exports. INSTALLATION While it is possible to install this module manually, by running perl Build.PL ./Build ./Build test ./Build install the recommended procedure is to use CPAN.pm or one of the other automated interfaces to the CPAN. DOCUMENTATION Full documentation in POD form is available in the .pm files in the distribution. After installation they can be read with perldoc in the usual way. AUTHOR Ben Morrow Test-Exports-1/t000755001751001751 011502564536 13530 5ustar00mauzousers000000000000Test-Exports-1/t/exports.t000444001751001751 522711502564536 15564 0ustar00mauzousers000000000000#!/usr/bin/perl use warnings; use strict; use Test::Tester; use Test::More; use Test::Exports; my $pkg = new_import_pkg; { package t::Export; sub foo { 1 } sub bar { 1 } no strict "refs"; *{"$pkg\::foo"} = \&foo; *{"$pkg\::bar"} = \&bar; } check_test sub { is_import "foo", "t::Export", "foo imported" }, { ok => 1, name => "foo imported" }, "is_import with one OK import"; check_test sub { is_import "foo", "bar", "t::Export", "foo+bar imported" }, { ok => 1, name => "foo+bar imported" }, "is_import with two OK imports"; check_test sub { is_import "baz", "t::Export", "baz imported" }, { ok => 0, name => "baz imported", diag => < 0, name => "foo not there", diag => < 0, name => "multi", diag => < 0, name => "new pkg", diag => < 1, name => "no subs" }, "is_import with no subs"; $pkg = new_import_pkg; { package t::Export; no strict "refs"; *{"$pkg\::foo"} = \&foo; } check_test sub { cant_ok "bar", "!bar" }, { ok => 1, name => "!bar" }, "cant_ok with nonexistent sub"; check_test sub { cant_ok "foo", "!foo" }, { ok => 0, name => "!foo", diag => < 0, name => "!baz", diag => < 0, name => "multi", diag => <import; 1; }, "import OK"; ok Test::Exports->isa("Test::Builder::Module"), "Test::Exports isa T::B::Module"; for (qw/ import_ok import_nok is_import cant_ok new_import_pkg /) { no strict "refs"; ok defined &$_, "&$_ exists"; ok \&$_ == \&{"Test::Exports\::$_"}, "...and has been imported"; } done_testing; Test-Exports-1/t/import.t000444001751001751 1105511502564536 15406 0ustar00mauzousers000000000000#!/usr/bin/perl use strict; use warnings; use Test::Tester; use Test::More; use Test::Exports; { package t::Import::OK; sub import { 1 } } { package t::Import::False; sub import { return } } { package t::Import::Die; # include \n to avoid matching 'at...line...' sub import { die "Bad import\n" } } check_test sub { import_ok "t::Import::OK", [], "import OK" }, { ok => 1, name => "import OK" }, "import_ok successful import"; check_test sub { import_ok "t::Import::False", [], "import false" }, { ok => 1, name => "import false" }, "import_ok false import"; my $finished_eval; check_test sub { eval { import_ok "t::Import::Die", [], "import die"; $finished_eval = 1; }; }, # extra depth for the eval{} { ok => 0, name => "import die", depth => 2, diag => <import() failed: Bad import DIAG "import_ok dying import"; ok $finished_eval, "import_ok caught exception"; check_test sub { import_nok "t::Import::OK", [], "import OK" }, { ok => 0, name => "import OK", diag => <import() succeeded where it should have failed. DIAG "import_nok successful import"; check_test sub { import_nok "t::Import::False", [], "import false" }, { ok => 0, name => "import false", diag => <import() succeeded where it should have failed. DIAG "import_nok false import"; $finished_eval = 0; check_test sub { eval { import_nok "t::Import::Die", [], "import die"; $finished_eval = 1; }; }, { ok => 1, name => "import die", depth => 2 }, "import_nok dying import"; ok $finished_eval, "import_nok caught exception"; my @import; { package t::Import::Args; sub import { @import = @_ } } { package t::Import::ArgsFail; sub import { @import = @_; die "argsfail\n" } } @import = (); check_test sub { import_ok "t::Import::Args", [1, 2, 3], "import args" }, { ok => 1, name => "import args" }, "import_ok with args"; is_deeply \@import, ["t::Import::Args", 1, 2, 3], "with correct args"; @import = (); check_test sub { import_ok "t::Import::ArgsFail", [1, 2, 3], "import args" }, { ok => 0, name => "import args", diag => <import(1, 2, 3) failed: argsfail DIAG "bad import_ok with args"; is_deeply \@import, ["t::Import::ArgsFail", 1, 2, 3], "correct args anyway"; @import = (); check_test sub { import_nok "t::Import::Args", [1, 2, 3], "import args" }, { ok => 0, name => "import args", diag => <import(1, 2, 3) succeeded where it should have failed. DIAG "import_nok with args"; is_deeply \@import, ["t::Import::Args", 1, 2, 3], "correct args"; @import = (); check_test sub { import_nok "t::Import::ArgsFail", [1, 2, 3], "import args" }, { ok => 1, name => "import args" }, "bad import_nok with args"; is_deeply \@import, ["t::Import::ArgsFail", 1, 2, 3], "correct args"; @import = (); check_test sub { import_ok "t::Import::Args", [4, 5] }, { ok => 1, name => "t::Import::Args->import(4, 5) succeeds" }, "import_ok with default name"; is_deeply \@import, ["t::Import::Args", 4, 5], "correct args"; @import = (); check_test sub { import_ok "t::Import::Args" }, { ok => 1, name => "t::Import::Args->import() succeeds" }, "import_ok with default args"; is_deeply \@import, ["t::Import::Args"], "correct args"; @import = (); check_test sub { import_nok "t::Import::ArgsFail", [5, 6] }, { ok => 1, name => "t::Import::ArgsFail->import(5, 6) fails" }, "import_nok with default name"; is_deeply \@import, ["t::Import::ArgsFail", 5, 6], "correct args"; @import = (); check_test sub { import_nok "t::Import::ArgsFail" }, { ok => 1, name => "t::Import::ArgsFail->import() fails" }, "import_nok with default args"; is_deeply \@import, ["t::Import::ArgsFail"], "correct args"; my $caller; { package t::Import::Pkg; sub import { $caller = caller } } $caller = "???"; my $pkg = new_import_pkg; check_test sub { import_ok "t::Import::Pkg", [], "pkg" }, { ok => 1, name => "pkg" }, "import_ok with package"; is $caller, $pkg, "import_ok uses correct package"; $caller = "???"; $pkg = new_import_pkg; check_test sub { import_nok "t::Import::Pkg", [], "pkg" }, { ok => 0, name => "pkg", diag => <import() succeeded where it should have failed. DIAG "import_nok with package"; is $caller, $pkg, "import_nok uses correct package"; done_testing; Test-Exports-1/lib000755001751001751 011502564536 14033 5ustar00mauzousers000000000000Test-Exports-1/lib/Test000755001751001751 011502564536 14752 5ustar00mauzousers000000000000Test-Exports-1/lib/Test/Exports.pm000444001751001751 1423111502564536 17132 0ustar00mauzousers000000000000package Test::Exports; =head1 NAME Test::Exports - Test that modules export the right symbols =head1 SYNOPSIS use Test::More; use Test::Exports; require_ok "My::Module" or BAIL_OUT "can't load module"; import_ok "My::Module", [], "default import OK"; is_import qw/foo bar/, "My::Module", "imports subs"; new_import_pkg; import_ok "My::Module", ["foo"], "named import OK"; is_import "foo", "My::Module", "imports foo"; cant_ok "bar", "doesn't import bar"; =head1 DESCRIPTION This module provides simple test functions for testing other modules' C methods. Testing is currently limited to checking which subs have been imported. In order to keep different calls to C<< ->import >> separate, Test::Exports performs these calls from a private package. The symbol-testing functions then test whether or not symbols are present in this private package, ensuring none of this interferes with your test script itself. =head1 FUNCTIONS These are all exported by default, as is usual with testing modules. =cut use warnings; use strict; use B; use parent "Test::Builder::Module"; our @EXPORT = qw/ new_import_pkg import_ok import_nok is_import cant_ok /; our $VERSION = "1"; my $CLASS = __PACKAGE__; =head2 C Create a new package to perform imports into. This is useful when you want to test C<< ->import >> with different arguments: otherwise you'd need to find some way of going back and clearing up the imports from the last call. This returns the name of the new package (which will look like C) in case you need it. =cut my $counter = "AAAAA"; my $PKG; sub new_import_pkg { $counter++; $PKG = "$CLASS\::Test$counter" } new_import_pkg; =head2 C Call C<< $module->import >> from the current testing package, passing C<@args>, and check the call succeeded. 'Success' means not throwing an exception: C doesn't care if C returns false, so neither do we. C<@args> defaults to the empty list; C<$name> defaults to something sensible. =cut sub import_ok { my ($mod, $args, $msg) = @_; my $tb = $CLASS->builder; local $" = ", "; $args ||= []; $msg ||= "$mod->import(@$args) succeeds"; my $code = "package $PKG; $mod->import(\@\$args); 1"; #$tb->diag($code); my $eval = eval $code; $tb->ok($eval, $msg) or $tb->diag(<import(@$args) failed: $@ DIAG } =head2 C Call C<< $module->import(@args) >> and expect it to throw an exception. Defaults as for L. =cut sub import_nok { my ($mod, $args, $msg) = @_; my $tb = $CLASS->builder; local $" = ", "; $args ||= []; $msg ||= "$mod->import(@$args) fails"; my $eval = eval "package $PKG; $mod->import(\@\$args); 1"; $tb->ok(!$eval, $msg) or $tb->diag(<import(@$args) succeeded where it should have failed. DIAG } =head2 C For each name in C<@subs>, check that the current testing package has a sub by that name and that it is the same as the equinominal sub in the C<$module> package. Neither C<$module> nor C<$name> are optional. =cut sub is_import { my $msg = pop; my $from = pop; my $tb = $CLASS->builder; my @nok; for (@_) { my $to = "$PKG\::$_"; no strict 'refs'; unless (defined &$to) { push @nok, <ok(!@nok, $msg) or $tb->diag(<diag($_) for @nok; return $ok; } =head2 C For each sub in @subs, check that a sub of that name does not exist in the current testing package. If one is found the diagnostic will indicate where it was originally defined, to help track down the stray export. =cut sub cant_ok { my $msg = pop; my $tb = $CLASS->builder; my @nok; for (@_) { my $can = $PKG->can($_); $can and push @nok, $_; } my $ok = $tb->ok(!@nok, $msg); for (@nok) { my $from = B::svref_2object($PKG->can($_))->GV->STASH->NAME; $tb->diag(< Currently this just checks that C<\&Our::Pkg::sub == \&Your::Pkg::sub>, which means =over 4 =item * it is impossible to test for exports which have been renamed, and =item * we can't be sure the sub originally came from Your::Pkg: it may have been exported into both packages from somewhere else. =back It would be good to fix at least the former. =head1 AUTHOR Ben Morrow =head1 BUGS Please report any bugs to . =head1 COPYRIGHT Copyright 2010 Ben Morrow. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: =over 4 =item * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. =item * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. =back THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. =cut 1;