]> git.vpit.fr Git - perl/modules/Variable-Magic.git/commitdiff
Update VPIT::TestHelpers to e8344578
authorVincent Pit <vince@profvince.com>
Wed, 30 Jan 2013 17:10:51 +0000 (15:10 -0200)
committerVincent Pit <vince@profvince.com>
Wed, 30 Jan 2013 17:10:51 +0000 (15:10 -0200)
12 files changed:
t/16-huf.t
t/25-copy.t
t/28-uvar.t
t/30-scalar.t
t/34-glob.t
t/91-pod.t
t/92-pod-coverage.t
t/93-pod-spelling.t
t/95-portability-files.t
t/99-kwalitee.t
t/lib/VPIT/TestHelpers.pm
t/lib/Variable/Magic/TestThreads.pm

index 0f9215c689a217f38af86d135a516ae8ed3bc179..024a39c9bb32ad90c71d2e6d571213b3cb8c01e0 100644 (file)
@@ -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';
index 04ed1c95fbd65d64a904c26a6498fc8c3ef7d7d0..394449541b3ab123f7ff015b0bf16834ab77c3a1 100644 (file)
@@ -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);
index d44f9f1f0b38ad3ff17446eef7ab53b6b7a9e0c3..4c6d9024f8770ec97af40eb9c7dad94598af859a 100644 (file)
@@ -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);
index 4189ee5dfab5491f4653232442c1f7eccf7ef6e2..59ab5e576a645685e596c8310b0581fc5fd0c22a 100644 (file)
@@ -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] = $$;
index 2e1a441a56b3c9cb10e5825cf5a1d8af4bb26339..af77a4fb795470a6c06fde61654315ebd6a8cd92 100644 (file)
@@ -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;
 }
 
index c2d16afc5e5e128da1975b349103c540ce71dd4b..34316658f5439cd1e333a7e2d76246555a7b8987 100644 (file)
@@ -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
 
index 6399021751882f13c74fed4faf95e1070acfd53c..ff5a3d182cfd91c7b06f7ab1a6bf4920ff355b45 100644 (file)
@@ -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
 
index 16367648ad585483951e74c77969838acdbc0bb0..817320949ccae4d5bf5e202cce84c7915f65950c 100644 (file)
@@ -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();
index 55a900519fec914952ad4fbb9a6ed6fee0944f68..711927148554b29fc35624362080396da64d9108 100644 (file)
@@ -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();
index 796fe6102f5a4e93c85e9476106898cf8fc8b407..337d917bb28b970a8d996e85c7fed24d10468b18 100644 (file)
@@ -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(); };
index 18f2b175570ca4ca6c36faeab56d589c7b256dca..3d545e887a78dbdccb62c79c423618bbd12a0629 100644 (file)
@@ -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;
index a11bae7bf815cee39f2584fb2074eb5e34322b17..e67ea3f13a99d3f4fcd89c67def4a4a0a48b7fce 100644 (file)
@@ -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,