From: Vincent Pit <vince@profvince.com>
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/?p=perl%2Fmodules%2FVariable-Magic.git;a=commitdiff_plain;h=93df7812b9a0da8cdfa57a107eb2f8f4b4744b49

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<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';
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<cast dispell>;
 
 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<wizard cast dispell VMG_UVAR>;
 
 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<wizard cast dispell>;
 
 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,