use Test::More;
-use Variable::Magic qw<wizard cast dispell VMG_UVAR>;
-
use lib 't/lib';
use VPIT::TestHelpers;
+use Variable::Magic qw<wizard cast dispell VMG_UVAR>;
+
if (VMG_UVAR) {
- load_or_skip('Hash::Util::FieldHash', undef, [ ],
- 'required for testing uvar interaction');
+ load_or_skip_all('Hash::Util::FieldHash', undef, [ ]);
plan tests => 2 * 5 + 7 + 1;
} else {
skip_all 'No nice uvar magic for this perl';
use Test::More;
+use lib 't/lib';
+use VPIT::TestHelpers;
+
use Variable::Magic qw<cast dispell>;
plan tests => 2 + ((2 * 5 + 3) + (2 * 2 + 1)) + (2 * 9 + 6) + 1;
my $wiz = init_watcher 'copy', 'copy';
SKIP: {
- my $has_tie_array = do { local $@; eval { require Tie::Array; 1 } };
- skip 'Tie::Array required to test copy magic on arrays'
- => (2 * 5 + 3) + (2 * 2 + 1) unless $has_tie_array;
- defined and diag "Using Tie::Array $_" for $Tie::Array::VERSION;
+ load_or_skip('Tie::Array', undef, undef, (2 * 5 + 3) + (2 * 2 + 1));
tie my @a, 'Tie::StdArray';
@a = (1 .. 10);
}
SKIP: {
- my $has_tie_hash = do { local $@; eval { require Tie::Hash; 1 } };
- skip 'Tie::Hash required to test copy magic on hashes'
- => 2 * 9 + 6 unless $has_tie_hash;
- defined and diag "Using Tie::Hash $_" for $Tie::Hash::VERSION;
+ load_or_skip('Tie::Hash', undef, undef, 2 * 9 + 6);
tie my %h, 'Tie::StdHash';
%h = (a => 1, b => 2, c => 3);
use Test::More;
+use lib 't/lib';
+use VPIT::TestHelpers;
+
use Variable::Magic qw<wizard cast dispell VMG_UVAR>;
if (VMG_UVAR) {
is $x, 1, 'uvar: fetch directly with also non uvar magic correctly';
SKIP: {
- my $has_tie_hash = do { local $@; eval { require Tie::Hash; 1 } };
- skip 'Tie::Hash required to test uvar magic on tied hashes'
- => 2 * 5 + 4 unless $has_tie_hash;
- defined and diag "Using Tie::Hash $_" for $Tie::Hash::VERSION;
+ load_or_skip('Tie::Hash', undef, undef, 2 * 5 + 4);
tie my %h, 'Tie::StdHash';
%h = (x => 7, y => 8);
use Test::More tests => (2 * 14 + 2) + 2 * (2 * 8 + 4) + 5 + 1;
+use lib 't/lib';
+use VPIT::TestHelpers;
+
use Variable::Magic qw<wizard cast dispell>;
use lib 't/lib';
watch { $h{b} = 4 } { }, 'hash element: set after delete';
SKIP: {
- unless (do { local $@; eval { require Tie::Array; 1 } }) {
- skip 'Tie::Array required to test clear magic on tied array values' => 5;
- }
- defined and diag "Using Tie::Array $_" for $Tie::Array::VERSION;
+ load_or_skip('Tie::Array', undef, undef, 5);
tie my @a, 'Tie::StdArray';
$a[0] = $$;
use VPIT::TestHelpers;
BEGIN {
- load_or_skip('Symbol', undef, [ 'gensym' ],
- 'required for testing magic for globs');
-
+ load_or_skip_all('Symbol', undef, [ 'gensym' ]);
plan tests => 2 * 17 + 1;
}
use lib 't/lib';
use VPIT::TestHelpers;
-load_or_skip('Test::Pod', '1.22', [ ],
- 'required for testing POD syntax');
+load_or_skip_all('Test::Pod', '1.22', [ ]);
eval 'use Test::Pod'; # Make Kwalitee test happy
use lib 't/lib';
use VPIT::TestHelpers;
-my $desc = 'required for testing POD coverage';
-
-load_or_skip('Test::Pod::Coverage', '1.08', [ ], $desc);
-load_or_skip('Pod::Coverage', '0.18', undef, $desc);
+load_or_skip_all('Test::Pod::Coverage', '1.08', [ ]);
+load_or_skip_all('Pod::Coverage', '0.18' );
eval 'use Test::Pod::Coverage'; # Make Kwalitee test happy
use lib 't/lib';
use VPIT::TestHelpers;
-load_or_skip('Test::Pod::Spelling::CommonMistakes', '1.0', [ ],
- 'required for testing POD spelling');
+load_or_skip_all('Test::Pod::Spelling::CommonMistakes', '1.0', [ ]);
all_pod_files_ok();
use lib 't/lib';
use VPIT::TestHelpers;
-load_or_skip('Test::Portability::Files', undef, [ ],
- 'required for testing filenames portability');
+load_or_skip_all('Test::Portability::Files', undef, [ ]);
run_tests();
sub { unlink for glob 'Debian_CPANTS.txt*' }
);
-my $desc = 'required to test kwalitee';
-
-load_or_skip('Parse::RecDescent', '1.967006', undef, $desc);
-load_or_skip('Module::ExtractUse', '0.24', undef, $desc);
-load_or_skip('Test::Kwalitee', '1.01', undef, $desc);
+load_or_skip_all('Parse::RecDescent', '1.967006');
+load_or_skip_all('Module::ExtractUse', '0.24' );
+load_or_skip_all('Test::Kwalitee', '1.01' );
SKIP: {
eval { Test::Kwalitee->import(); };
use warnings;
my %exports = (
- load_or_skip => \&load_or_skip,
- skip_all => \&skip_all,
+ load_or_skip => \&load_or_skip,
+ load_or_skip_all => \&load_or_skip_all,
+ skip_all => \&skip_all,
);
sub import {
my $pkg = caller;
+
while (my ($name, $code) = each %exports) {
no strict 'refs';
*{$pkg.'::'.$name} = $code;
}
}
-sub skip_all {
- my ($msg) = @_;
- require Test::More;
- Test::More::plan(skip_all => $msg);
-}
+my $test_sub = sub {
+ my $sub = shift;
+
+ my $stash;
+ if ($INC{'Test/Leaner.pm'}) {
+ $stash = \%Test::Leaner::;
+ } else {
+ require Test::More;
+ $stash = \%Test::More::;
+ }
+
+ my $glob = $stash->{$sub};
+ return $glob ? *$glob{CODE} : undef;
+};
+
+sub skip { $test_sub->('skip')->(@_) }
+
+sub skip_all { $test_sub->('plan')->(skip_all => $_[0]) }
sub diag {
- require Test::More;
- Test::More::diag($_) for @_;
+ my $diag = $test_sub->('diag');
+ $diag->($_) for @_;
}
our $TODO;
local $TODO;
-sub load_or_skip {
- my ($pkg, $ver, $imports, $desc) = @_;
+sub load {
+ my ($pkg, $ver, $imports) = @_;
+
my $spec = $ver && $ver !~ /^[0._]*$/ ? "$pkg $ver" : $pkg;
+ my $err;
+
local $@;
if (eval "use $spec (); 1") {
$ver = do { no strict 'refs'; ${"${pkg}::VERSION"} };
$ver = 'undef' unless defined $ver;
+
if ($imports) {
my @imports = @$imports;
- my $caller = (caller 0)[0];
+ my $caller = (caller 1)[0];
local $@;
my $res = eval <<"IMPORTER";
package
BEGIN { \$pkg->import(\@imports) }
1;
IMPORTER
- skip_all "Could not import '@imports' from $pkg $ver: $@" unless $res;
+ $err = "Could not import '@imports' from $pkg $ver: $@" unless $res;
}
- diag "Using $pkg $ver";
} else {
- skip_all "$spec $desc";
+ (my $file = "$pkg.pm") =~ s{::}{/}g;
+ delete $INC{$file};
+ $err = "Could not load $spec";
}
+
+ if ($err) {
+ return wantarray ? (0, $err) : 0;
+ } else {
+ diag "Using $pkg $ver";
+ return 1;
+ }
+}
+
+sub load_or_skip {
+ my ($pkg, $ver, $imports, $tests) = @_;
+
+ die 'You must specify how many tests to skip' unless defined $tests;
+
+ my ($loaded, $err) = load($pkg, $ver, $imports);
+ skip $err => $tests unless $loaded;
+
+ return $loaded;
+}
+
+sub load_or_skip_all {
+ my ($pkg, $ver, $imports) = @_;
+
+ my ($loaded, $err) = load($pkg, $ver, $imports);
+ skip_all $err unless $loaded;
+
+ return $loaded;
}
package VPIT::TestHelpers::Guard;
skip_all 'perl 5.13.4 required to test thread safety'
unless $force or "$]" >= 5.013_004;
- my $desc = 'required to test thread safety';
- load_or_skip('threads', $force ? '0' : '1.67', [ ], $desc);
- load_or_skip('threads::shared', $force ? '0' : '1.14', [ ], $desc);
+ load_or_skip_all('threads', $force ? '0' : '1.67', [ ]);
+ load_or_skip_all('threads::shared', $force ? '0' : '1.14', [ ]);
my %exports = (
spawn => \&spawn,