1use 5.008001;
2use strict;
3use warnings;
4
5package SubtestCompat;
6
7# XXX must be used with no_plan or done_testing
8use Test::More 0.88;
9
10use base 'Exporter';
11our @EXPORT;
12
13our $INDENT = -2;
14
15# intercept 'skip_all' in subtest and turn into a regular skip
16sub _fake_plan {
17    my ( $self, $cmd, $arg ) = @_;
18
19    return unless $cmd;
20
21    if ( $cmd eq 'skip_all' ) {
22        die bless { reason => $arg }, "Subtest::SKIP";
23    }
24    else {
25        goto &Test::Builder::plan;
26    }
27}
28
29unless ( Test::More->can("subtest") ) {
30    *subtest = sub {
31        my ( $label, $code ) = @_;
32        local $Test::Builder::Level = $Test::Builder::Level + 1;
33
34        local $INDENT = $INDENT + 2;
35
36        $label = "TEST: $label";
37        my $sep_len = 60 - length($label);
38
39        note( " " x $INDENT . "$label { " . ( " " x ($sep_len-$INDENT-2) ) );
40        eval {
41            no warnings 'redefine';
42            local *Test::Builder::plan = \&_fake_plan;
43            # only want subtest error reporting to look up to the code ref
44            # for where test was called, not further up to *our* callers,
45            # so we *reset* the Level, rather than increment it
46            local $Test::Builder::Level = 1;
47            $code->();
48        };
49        if ( my $err = $@ ) {
50            if ( ref($err) eq 'Subtest::SKIP' ) {
51                SKIP: {
52                    skip $err->{reason}, 1;
53                }
54            }
55            else {
56                fail("SUBTEST: $label");
57                diag("Caught exception: $err");
58                die "$err\n";
59            }
60        }
61        note( " " x $INDENT . "}" );
62    };
63    push @EXPORT, 'subtest';
64}
65
661;
67