From: Vincent Pit Date: Wed, 30 Jan 2013 17:10:51 +0000 (-0200) Subject: Update VPIT::TestHelpers to e8344578 X-Git-Tag: rt86338~1 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=93df7812b9a0da8cdfa57a107eb2f8f4b4744b49;p=perl%2Fmodules%2FVariable-Magic.git Update VPIT::TestHelpers to e8344578 --- diff --git a/t/16-huf.t b/t/16-huf.t index 0f9215c..024a39c 100644 --- a/t/16-huf.t +++ b/t/16-huf.t @@ -5,14 +5,13 @@ use warnings; use Test::More; -use Variable::Magic qw; - use lib 't/lib'; use VPIT::TestHelpers; +use Variable::Magic qw; + 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'; diff --git a/t/25-copy.t b/t/25-copy.t index 04ed1c9..3944495 100644 --- a/t/25-copy.t +++ b/t/25-copy.t @@ -5,6 +5,9 @@ use warnings; use Test::More; +use lib 't/lib'; +use VPIT::TestHelpers; + use Variable::Magic qw; plan tests => 2 + ((2 * 5 + 3) + (2 * 2 + 1)) + (2 * 9 + 6) + 1; @@ -16,10 +19,7 @@ use Variable::Magic::TestValue; 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); @@ -51,10 +51,7 @@ SKIP: { } 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); diff --git a/t/28-uvar.t b/t/28-uvar.t index d44f9f1..4c6d902 100644 --- a/t/28-uvar.t +++ b/t/28-uvar.t @@ -5,6 +5,9 @@ use warnings; use Test::More; +use lib 't/lib'; +use VPIT::TestHelpers; + use Variable::Magic qw; if (VMG_UVAR) { @@ -51,10 +54,7 @@ $x = watch { $h{a} } { fetch => 1 }, 'fetch directly with also non uvar magic'; 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); diff --git a/t/30-scalar.t b/t/30-scalar.t index 4189ee5..59ab5e5 100644 --- a/t/30-scalar.t +++ b/t/30-scalar.t @@ -7,6 +7,9 @@ use Config qw<%Config>; use Test::More tests => (2 * 14 + 2) + 2 * (2 * 8 + 4) + 5 + 1; +use lib 't/lib'; +use VPIT::TestHelpers; + use Variable::Magic qw; use lib 't/lib'; @@ -103,10 +106,7 @@ is $b, 6, 'scalar: hash element: delete correctly'; 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] = $$; diff --git a/t/34-glob.t b/t/34-glob.t index 2e1a441..af77a4f 100644 --- a/t/34-glob.t +++ b/t/34-glob.t @@ -9,9 +9,7 @@ use lib 't/lib'; 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; } diff --git a/t/91-pod.t b/t/91-pod.t index c2d16af..3431665 100644 --- a/t/91-pod.t +++ b/t/91-pod.t @@ -8,8 +8,7 @@ use Test::More; 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 diff --git a/t/92-pod-coverage.t b/t/92-pod-coverage.t index 6399021..ff5a3d1 100644 --- a/t/92-pod-coverage.t +++ b/t/92-pod-coverage.t @@ -8,10 +8,8 @@ use Test::More; 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 diff --git a/t/93-pod-spelling.t b/t/93-pod-spelling.t index 1636764..8173209 100644 --- a/t/93-pod-spelling.t +++ b/t/93-pod-spelling.t @@ -8,7 +8,6 @@ use Test::More; 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(); diff --git a/t/95-portability-files.t b/t/95-portability-files.t index 55a9005..7119271 100644 --- a/t/95-portability-files.t +++ b/t/95-portability-files.t @@ -8,7 +8,6 @@ use Test::More; 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(); diff --git a/t/99-kwalitee.t b/t/99-kwalitee.t index 796fe61..337d917 100644 --- a/t/99-kwalitee.t +++ b/t/99-kwalitee.t @@ -12,11 +12,9 @@ my $guard = VPIT::TestHelpers::Guard->new( 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(); }; diff --git a/t/lib/VPIT/TestHelpers.pm b/t/lib/VPIT/TestHelpers.pm index 18f2b17..3d545e8 100644 --- a/t/lib/VPIT/TestHelpers.pm +++ b/t/lib/VPIT/TestHelpers.pm @@ -4,42 +4,61 @@ use strict; 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 @@ -47,12 +66,40 @@ 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; diff --git a/t/lib/Variable/Magic/TestThreads.pm b/t/lib/Variable/Magic/TestThreads.pm index a11bae7..e67ea3f 100644 --- a/t/lib/Variable/Magic/TestThreads.pm +++ b/t/lib/Variable/Magic/TestThreads.pm @@ -25,9 +25,8 @@ sub import { 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,