Fall back to Test::More when PERL_TEST_LEANER_USES_TEST_MORE is set

diff --git a/MANIFEST b/MANIFEST
index 734c6e9ba1a26c0447063a71889ea3f20cc6e38b..7b33b2e0b4c795634db26b0360dec0bd97079729 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -7,6 +7,7 @@ lib/Test/Leaner.pm
 samples/bench.pl
 t/00-load.t
 t/01-import.t
+t/02-fallback.t
 t/05-pass.t
 t/06-fail.t
 t/07-BAIL_OUT.t

diff --git a/lib/Test/Leaner.pm b/lib/Test/Leaner.pm
index bc684ec1c99ab662e9e6c0edefd53513432e3a5f..6f90cef1ae4663704ee01802d81ea66c00693396 100644 (file)
--- a/lib/Test/Leaner.pm
+++ b/lib/Test/Leaner.pm
@@ -98,6 +98,119 @@ my ($TAP_STREAM, $DIAG_STREAM);
 
 my ($plan, $test, $failed, $no_diag, $done_testing);
 
+our @EXPORT = qw<
+ plan
+ skip
+ done_testing
+ pass
+ fail
+ ok
+ is
+ isnt
+ like
+ unlike
+ cmp_ok
+ is_deeply
+ diag
+ note
+ BAIL_OUT
+>;
+
+=head1 ENVIRONMENT
+
+=head2 C<PERL_TEST_LEANER_USES_TEST_MORE>
+
+If this environment variable is set, L<Test::Leaner> will replace its functions by those from L<Test::More>.
+Moreover, the symbols that are imported you C<use Test::Leaner> will be those from L<Test::More>, but you can still only import the symbols originally defined in L<Test::Leaner> (hence the functions from L<Test::More> that are not implemented in L<Test::Leaner> will not be imported).
+If your version of L<Test::More> is too old and doesn't have some symbols (like L</note> or L</done_testing>), they will be replaced in L<Test::Leaner> by croaking stubs.
+
+This may be useful if your L<Test::Leaner>-based test script fails and you want extra diagnostics.
+
+=cut
+
+sub _handle_import_args {
+ my @imports;
+
+ my $i = 0;
+ while ($i <= $#_) {
+  my $item = $_[$i];
+  my $splice;
+  if (defined $item) {
+   if ($item eq 'import') {
+    push @imports, @{ $_[$i+1] };
+    $splice  = 2;
+   } elsif ($item eq 'no_diag') {
+    lock $plan if THREADSAFE;
+    $no_diag = 1;
+    $splice  = 1;
+   }
+  }
+  if ($splice) {
+   splice @_, $i, $splice;
+  } else {
+   ++$i;
+  }
+ }
+
+ return @imports;
+}
+
+if ($ENV{PERL_TEST_LEANER_USES_TEST_MORE}) {
+ require Test::More;
+
+ my $leaner_stash = \%Test::Leaner::;
+ my $more_stash   = \%Test::More::;
+
+ my %valid_imports;
+
+ for (@EXPORT) {
+  my $replacement = exists $more_stash->{$_} ? *{$more_stash->{$_}}{CODE}
+                                             : undef;
+  if (defined $replacement) {
+   $valid_imports{$_} = 1;
+  } else {
+   $replacement = sub {
+    @_ = ("$_ is not implemented in this version of Test::More");
+    goto &croak;
+   };
+  }
+  no warnings 'redefine';
+  $leaner_stash->{$_} = $replacement;
+ }
+
+ my $import = sub {
+  shift;
+  my @imports = &_handle_import_args;
+  @imports = @EXPORT unless @imports;
+  my @test_more_imports;
+  for (@imports) {
+   if ($valid_imports{$_}) {
+    push @test_more_imports, $_;
+   } else {
+    my $pkg = caller;
+    no strict 'refs';
+    *{$pkg."::$_"} = $leaner_stash->{$_};
+   }
+  }
+  my $test_more_import = 'Test::More'->can('import');
+  @_ = (
+   'Test::More',
+   @_,
+   import => \@test_more_imports,
+  );
+  {
+   lock $plan if THREADSAFE;
+   push @_, 'no_diag' if $no_diag;
+  }
+  goto $test_more_import;
+ };
+
+ no warnings 'redefine';
+ *import = $import;
+
+ return 1;
+}
+
 sub NO_PLAN  () { -1 }
 sub SKIP_ALL () { -2 }
 
@@ -115,13 +228,21 @@ BEGIN {
 
 sub carp {
  my $level = 1 + ($Test::Builder::Level || 0);
- my ($file, $line) = (caller $level)[1, 2];
+ my @caller;
+ do {
+  @caller = caller $level--;
+ } while (!@caller and $level >= 0);
+ my ($file, $line) = @caller[1, 2];
  warn @_, " at $file line $line.\n";
 }
 
 sub croak {
  my $level = 1 + ($Test::Builder::Level || 0);
- my ($file, $line) = (caller $level)[1, 2];
+ my @caller;
+ do {
+  @caller = caller $level--;
+ } while (!@caller and $level >= 0);
+ my ($file, $line) = @caller[1, 2];
  die @_, " at $file line $line.\n";
 }
 
@@ -184,48 +305,10 @@ sub plan {
  return 1;
 }
 
-our @EXPORT = qw<
- plan
- skip
- done_testing
- pass
- fail
- ok
- is
- isnt
- like
- unlike
- cmp_ok
- is_deeply
- diag
- note
- BAIL_OUT
->;
-
 sub import {
  my $class = shift;
 
- my @imports;
- my $i = 0;
- while ($i <= $#_) {
-  my $item = $_[$i];
-  my $splice;
-  if (defined $item) {
-   if ($item eq 'import') {
-    push @imports, @{ $_[$i+1] };
-    $splice  = 2;
-   } elsif ($item eq 'no_diag') {
-    lock $plan if THREADSAFE;
-    $no_diag = 1;
-    $splice  = 1;
-   }
-  }
-  if ($splice) {
-   splice @_, $i, $splice;
-  } else {
-   ++$i;
-  }
- }
+ my @imports = &_handle_import_args;
 
  if (@_) {
   local $Test::Builder::Level = ($Test::Builder::Level || 0) + 1;

diff --git a/t/00-load.t b/t/00-load.t
index 77213993b8da888a11431aa0fdddd04c442eb1a7..988eab105e24c01cf7345543061a486f194b198f 100644 (file)
--- a/t/00-load.t
+++ b/t/00-load.t
@@ -5,6 +5,8 @@ use warnings;
 
 use Test::More tests => 1;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 {
  package Test::Leaner::TestContainer;
  BEGIN {

diff --git a/t/01-import.t b/t/01-import.t
index 3b42068d7fb9cb90ba3775bc76015583df607ed0..9fe04df4ee1a6b15fba5a885fb87d180f8f5e426 100644 (file)
--- a/t/01-import.t
+++ b/t/01-import.t
@@ -5,7 +5,10 @@ use warnings;
 
 use Test::More ();
 
-BEGIN { *tm_is = \&Test::More::is }
+BEGIN {
+ delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE};
+ *tm_is = \&Test::More::is;
+}
 
 Test::More::plan(tests => 2 * 15);
 

diff --git a/t/02-fallback.t b/t/02-fallback.t
new file mode 100644 (file)
index 0000000..3bda266
--- /dev/null
+++ b/t/02-fallback.t
@@ -0,0 +1,124 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+BEGIN { $ENV{PERL_TEST_LEANER_USES_TEST_MORE} = 1 }
+
+use Test::Leaner;
+
+BEGIN {
+ my $loaded;
+ if ($INC{'Test/More.pm'}) {
+  $loaded = 1;
+ } else {
+  $loaded = 0;
+  require Test::More;
+  Test::More->import;
+ }
+ Test::More::plan(tests => 1 + 4 * 15 + 3 * 3 + 2 * 8);
+ Test::More::is($loaded, 1, 'Test::More has been loaded');
+}
+
+sub get_subroutine {
+ my ($stash, $name) = @_;
+
+ my $glob = $stash->{$name};
+ return undef unless $glob;
+
+ return *$glob{CODE};
+}
+
+my $leaner_stash = \%Test::Leaner::;
+my $more_stash   = \%Test::More::;
+my $this_stash   = \%main::;
+
+my @exported = qw<
+ plan
+ skip
+ done_testing
+ pass
+ fail
+ ok
+ is
+ isnt
+ like
+ unlike
+ cmp_ok
+ is_deeply
+ diag
+ note
+ BAIL_OUT
+>;
+
+for (@exported) {
+ my $more_variant     = get_subroutine($more_stash, $_);
+
+ my $leaner_variant   = get_subroutine($leaner_stash, $_);
+ Test::More::ok(defined $leaner_variant,
+                                       "Test::Leaner variant of $_ is defined");
+ my $imported_variant = get_subroutine($this_stash, $_);
+ Test::More::ok(defined $imported_variant, "imported variant of $_ is defined");
+
+ SKIP: {
+  Test::More::skip('Need leaner and imported variants to be defined' => 2)
+                   unless defined $leaner_variant
+                      and defined $imported_variant;
+
+  if (defined $more_variant) {
+   Test::More::is($leaner_variant, $more_variant,
+                  "Test::Leaner variant of $_ is Test::More variant");
+   Test::More::is($imported_variant, $more_variant,
+                  "imported variant of $_ is Test::More variant");
+  } else {
+   Test::More::is($imported_variant, $leaner_variant,
+                  "imported variant of $_ is Test::Leaner variant");
+   {
+    local $@;
+    eval { $leaner_variant->() };
+    Test::More::like($@, qr/^\Q$_\E is not implemented.*at \Q$0\E line \d+/,
+                         "Test::Leaner of $_ variant croaks");
+   }
+  }
+ }
+}
+
+my @only_in_test_leaner = qw<
+ tap_stream
+ diag_stream
+ THREADSAFE
+>;
+
+for (@only_in_test_leaner) {
+ Test::More::ok(exists $leaner_stash->{$_},
+                "$_ still exists in Test::Leaner");
+ Test::More::ok(!exists $more_stash->{$_},
+                "$_ was not imported into Test::More");
+ Test::More::ok(!exists $this_stash->{$_},
+                "$_ was not imported into main");
+}
+
+my @only_in_test_more = qw<
+ use_ok
+ require_ok
+ can_ok
+ isa_ok
+ new_ok
+ subtest
+ explain
+ todo_skip
+>;
+
+for (@only_in_test_more) {
+ my $more_variant = get_subroutine($more_stash, $_);
+
+ SKIP: {
+  Test::More::skip("$_ is not implemented in this version of Test::More" => 2)
+                   unless defined $more_variant;
+
+  Test::More::ok(!exists $leaner_stash->{$_},
+                 "$_ was not imported into Test::Leaner");
+  Test::More::ok(!exists $this_stash->{$_},
+                 "$_ was not imported into main");
+ }
+}

diff --git a/t/05-pass.t b/t/05-pass.t
index ecc6df18586eacbc49d034bb41a3c727662b80e4..8c1cb9884baf20d63cc3f33b73b4d4344f9030da 100644 (file)
--- a/t/05-pass.t
+++ b/t/05-pass.t
@@ -5,6 +5,8 @@ use warnings;
 
 use Test::More;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner ();
 
 use lib 't/lib';

diff --git a/t/06-fail.t b/t/06-fail.t
index 2f1fddfca42353c93a87f796254a026d68daf744..08d0f13496f52e569bd950610337ba4bb77f03cd 100644 (file)
--- a/t/06-fail.t
+++ b/t/06-fail.t
@@ -5,6 +5,8 @@ use warnings;
 
 use Test::More;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner ();
 
 use lib 't/lib';

diff --git a/t/07-BAIL_OUT.t b/t/07-BAIL_OUT.t
index b1fe00b74c3691c1f530240e908c34d9037ec658..8fd396458c3d5b059cdb58862ef53ef598fdcc8c 100644 (file)
--- a/t/07-BAIL_OUT.t
+++ b/t/07-BAIL_OUT.t
@@ -15,6 +15,8 @@ BEGIN {
    CORE::exit $_[0];
   }
  };
+
+ delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE};
 }
 
 use Test::Leaner ();

diff --git a/t/10-plan-tests.t b/t/10-plan-tests.t
index b4efe8e0163cebdf093b487b569a08e3e663812a..2d731ed691744a18d14329b08680f8da44315661 100644 (file)
--- a/t/10-plan-tests.t
+++ b/t/10-plan-tests.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner;
 
 plan tests => 2;

diff --git a/t/11-plan-no_plan.t b/t/11-plan-no_plan.t
index c3722cbdb9043b301a134ed670d98396aff97556..74bbf73002a6f75466162aaa988e73d03105c08a 100644 (file)
--- a/t/11-plan-no_plan.t
+++ b/t/11-plan-no_plan.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner;
 
 plan 'no_plan';

diff --git a/t/12-plan-skip_all.t b/t/12-plan-skip_all.t
index 6dd36bc2f2cba4c140f61ba030909904f97b5710..da77919ad7f70e430632ddf1cf924af0fcaa5543 100644 (file)
--- a/t/12-plan-skip_all.t
+++ b/t/12-plan-skip_all.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner;
 
 plan skip_all => 'testing plan skip_all';

diff --git a/t/13-use-tests.t b/t/13-use-tests.t
index c0bc3a7e548b04690811831512fab96673146b79..b739a3ff5f47156eb930eb2a98e6384beb7ebfcd 100644 (file)
--- a/t/13-use-tests.t
+++ b/t/13-use-tests.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner tests => 2;
 
 pass;

diff --git a/t/14-use-no_plan.t b/t/14-use-no_plan.t
index bbdcf30d5c18136a0d7b8f85f9d0a9cc0d5303ae..575e1208f9c46a77a2c29d4a5383a047ad84e531 100644 (file)
--- a/t/14-use-no_plan.t
+++ b/t/14-use-no_plan.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner 'no_plan';
 
 pass;

diff --git a/t/15-use-skip_all.t b/t/15-use-skip_all.t
index c423d171d507aacd22d91dee18a316119868c1b4..60350ca8814063c395e4f94a72a4f165fa37b8f9 100644 (file)
--- a/t/15-use-skip_all.t
+++ b/t/15-use-skip_all.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner skip_all => 'testing use skip_all';
 
 die 'should not be reached';

diff --git a/t/16-done_testing.t b/t/16-done_testing.t
index 66f0e3418922f514d0e05c13202bdd539211541e..f078c1fe61839972bbadda487badf950a363fd8c 100644 (file)
--- a/t/16-done_testing.t
+++ b/t/16-done_testing.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner;
 
 plan 'no_plan';

diff --git a/t/17-plan-done_testing.t b/t/17-plan-done_testing.t
index 3da4c1fabf73ab92d2de2c09ac01fbb8149cf33d..a3d69f59e1f970bf7e9fb179622f854e4750a7c1 100644 (file)
--- a/t/17-plan-done_testing.t
+++ b/t/17-plan-done_testing.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner;
 
 plan tests => 2;

diff --git a/t/18-skip.t b/t/18-skip.t
index 05fa3ae7546c8d8108b0a61df8f2f4566a2da2f1..722607b82aa9e3168e6310b26b3a97425ca1774c 100644 (file)
--- a/t/18-skip.t
+++ b/t/18-skip.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner tests => 7;
 
 pass 'test begin';

diff --git a/t/19-comments.t b/t/19-comments.t
index b9ad8cd5ead1539d91e03862976ed544827c78e4..9e490abd349b1645b967a9911bb7e5556e715880 100644 (file)
--- a/t/19-comments.t
+++ b/t/19-comments.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner tests => 1;
 
 note <<'NOTE';

diff --git a/t/20-ok.t b/t/20-ok.t
index e6fcafe8063cb8f27643ef95e0b9e3bdd9c30f3a..19e989a0a2ecaf57d4d7b4b4265cd43d35a0d83c 100644 (file)
--- a/t/20-ok.t
+++ b/t/20-ok.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner tests => 4 + 1 + 2 + 1;
 
 ok 1;

diff --git a/t/21-ok-failing.t b/t/21-ok-failing.t
index c00ab83db7e3622cbd1584bd8335242174ee8bf5..c54fde80e52ef17168f74d4abe1b0cf50f241de3 100644 (file)
--- a/t/21-ok-failing.t
+++ b/t/21-ok-failing.t
@@ -5,6 +5,8 @@ use warnings;
 
 use Test::More;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner ();
 
 use lib 't/lib';

diff --git a/t/22-is.t b/t/22-is.t
index 2059fca2dc8baa86f4a432334276e846966bf1e5..d4baf6eab2e4dbb4b78e902f001c69f8c9c9c918 100644 (file)
--- a/t/22-is.t
+++ b/t/22-is.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner;
 
 plan tests => 8;

diff --git a/t/24-cmp_ok.t b/t/24-cmp_ok.t
index 106ca5f0507fc23dad092d2cae2c7aaf2e8b4e6f..dee3dc39b53a19ffc8f7a69c239f44b2cc1de651 100644 (file)
--- a/t/24-cmp_ok.t
+++ b/t/24-cmp_ok.t
@@ -3,6 +3,10 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
+use Test::Leaner tests => 7 * 10 + 4 * 7 + 10;
+
 {
  package Test::Leaner::TestCmpNum;
 
@@ -24,8 +28,6 @@ use warnings;
  }
 }
 
-use Test::Leaner tests => 7 * 10 + 4 * 7 + 10;
-
 my @num_tests = (
  [ '1.0', '==', '1.0' ],
  [ '1e0', '==', '1e0' ],

diff --git a/t/26-is_deeply.t b/t/26-is_deeply.t
index d4550409f41cb36e6be0b74c411a00f4b4291c0f..d4da1dc280afe70cf431ec3453332ed900137b07 100644 (file)
--- a/t/26-is_deeply.t
+++ b/t/26-is_deeply.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner tests => 21 + 2 + 1 + 2;
 
 my $lacunary = [ [ 1, 2, 3 ] => [ 1, 2, 3 ] ];

diff --git a/t/27-is_deeply-failing.t b/t/27-is_deeply-failing.t
index e36f9adceadf0ae8c4c47f9b8da7b73ecf620f64..dda1874261e9dfa8e5a78f4a4240c8ead23179ac 100644 (file)
--- a/t/27-is_deeply-failing.t
+++ b/t/27-is_deeply-failing.t
@@ -5,6 +5,8 @@ use warnings;
 
 use Test::More;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner ();
 
 use lib 't/lib';

diff --git a/t/28-is_deeply-deep.t b/t/28-is_deeply-deep.t
index 2beae5006d0465ae1b757b65e77c2ba7e1045122..6c15cd226eeed674c790356c219b9f4f82d890c1 100644 (file)
--- a/t/28-is_deeply-deep.t
+++ b/t/28-is_deeply-deep.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 use Test::Leaner tests => 2;
 
 sub create_chain {

diff --git a/t/80-threads.t b/t/80-threads.t
index a04d1b9ff4935bc897b22a589b923d47b98dec3d..8d872eef38b1ad21bbc134db52fe061b841b642e 100644 (file)
--- a/t/80-threads.t
+++ b/t/80-threads.t
@@ -3,6 +3,8 @@
 use strict;
 use warnings;
 
+BEGIN { delete $ENV{PERL_TEST_LEANER_USES_TEST_MORE} }
+
 sub skipall {
  my ($msg) = @_;
  require Test::Leaner;