path: root/cpan/Test-Simple/t/Test-Stream-API.t

use strict;
use warnings;

use Test::Stream;
use Test::More;
use Test::Stream::Tester qw/events_are event directive check/;
use Test::MostlyLike;

require Test::Builder;
require Test::CanFork;

use Test::Stream::API qw{
    listen munge follow_up
    enable_forking cull
    peek_todo push_todo pop_todo set_todo inspect_todo
    is_tester init_tester
    is_modern set_modern
    context peek_context clear_context set_context
    intercept
    state_count state_failed state_plan state_ended is_passing
    current_stream

    disable_tap enable_tap subtest_tap_instant subtest_tap_delayed tap_encoding
    enable_numbers disable_numbers set_tap_outputs get_tap_outputs
};

can_ok(__PACKAGE__, qw{
    listen munge follow_up
    enable_forking cull
    peek_todo push_todo pop_todo set_todo inspect_todo
    is_tester init_tester
    is_modern set_modern
    context peek_context clear_context set_context
    intercept
    state_count state_failed state_plan state_ended is_passing
    current_stream

    disable_tap enable_tap subtest_tap_instant subtest_tap_delayed tap_encoding
    enable_numbers disable_numbers set_tap_outputs get_tap_outputs
});

ok(!is_tester('My::Tester'), "Not a tester");
isa_ok(init_tester('My::Tester'), 'Test::Stream::Meta');
isa_ok(is_tester('My::Tester'), 'Test::Stream::Meta');

ok(!is_modern('My::Tester'), "Not a modern tester");
set_modern('My::Tester', 1);
ok(is_modern('My::Tester'), "a modern tester");
set_modern('My::Tester', 0);
ok(!is_modern('My::Tester'), "Not a modern tester");

ok(my $ctx = context(), "Got context");
isa_ok($ctx, 'Test::Stream::Context');
is(context(), $ctx, "Got the same instance again");
is(peek_context(), $ctx, "peek");
my $ref = "$ctx";

clear_context();
my $ne = context() . "" ne $ref;
ok($ne, "cleared");

set_context($ctx);
is(context(), $ctx, "Got the same instance again");

$ctx = undef;
$ne = context() . "" ne $ref;
ok($ne, "New instance");

isa_ok(current_stream(), 'Test::Stream');

my @munge;
my @listen;
my @follow;
intercept {
    munge  { push @munge  => $_[1] };
    listen { push @listen => $_[1] };

    follow_up { push @follow => $_[0]->snapshot };

    ok(1, "pass");
    diag "foo";

    done_testing;
};

is(@listen, 3, "listen got 3 events");
is(@munge,  3, "munge got 3 events");
is(@follow, 1, "Follow was triggered");

my $want = check {
    event ok => { bool => 1 };
    event diag => { message => 'foo' };
    event plan => { max => 1 };
    directive 'end';
};
events_are( \@listen, $want, "Listen events" );
events_are( \@munge, $want, "Munge events" );
isa_ok($follow[0], 'Test::Stream::Context');

my $events = intercept {
    Test::CanFork->import;

    enable_forking;

    my $pid = fork();
    if ($pid) { # Parent
        waitpid($pid, 0);
        cull;
        ok(1, "From Parent");
    }
    else { # child
        ok(1, "From Child");
        exit 0;
    }
};

if (@$events == 1) {
    events_are (
        $events,
        check {
            event plan => {};
        },
        "Not testing forking"
    );
}
else {
    events_are (
        $events,
        check {
            event ok => { name => 'From Child' };
            event ok => { name => 'From Parent' };
        },
        "Got forked events"
    );
}

events_are(
    intercept {
        ok(0, "fail");
        push_todo('foo');
        ok(0, "fail");
        push_todo('bar');
        ok(0, "fail");
        is(peek_todo(), 'bar', "peek works");
        pop_todo();
        ok(0, "fail");
        pop_todo();
        ok(0, "fail");
    },
    check {
        event ok => {todo => '',    in_todo   => 0};
        event ok => {todo => 'foo', in_todo   => 1};
        event ok => {todo => 'bar', in_todo   => 1};
        event ok => {bool => 1,     real_bool => 1}; # Verify peek
        event ok => {todo => 'foo', in_todo   => 1};
        event ok => {todo => '',    in_todo   => 0};
    },
    "Verified TODO stack"
);

my $meta = init_tester('My::Tester');
ok(!$meta->todo, "Package is not in todo");
set_todo('My::Tester', 'foo');
is($meta->todo, 'foo', "Package is in todo");

my @todos = (
    inspect_todo,
    inspect_todo('My::Tester'),
);
push_todo('foo');
push_todo('bar');
Test::Builder->new->todo_start('tb todo');
$My::Tester::TODO = 'pkg todo';
push @todos => inspect_todo, inspect_todo('My::Tester');
$My::Tester::TODO = undef;
Test::Builder->new->todo_end();
pop_todo;
pop_todo;
set_todo('My::Tester', undef);
push @todos => inspect_todo, inspect_todo('My::Tester');

is_deeply(
    \@todos,
    [
        {
            TB   => undef,
            TODO => [],
        },
        {
            META => 'foo',
            PKG  => undef,
            TB   => undef,
            TODO => [],
        },
        {
            TB   => 'tb todo',
            TODO => [qw/foo bar/],
        },
        {
            META => 'foo',
            PKG  => 'pkg todo',
            TB   => 'tb todo',
            TODO => [qw/foo bar/],
        },
        {
            TB   => undef,
            TODO => [],
        },
        {
            META => undef,
            PKG  => undef,
            TB   => undef,
            TODO => [],
        }
    ],
    "Todo state from inspect todo"
);

my @state;
intercept {
    plan tests => 3;
    ok(1, "pass");
    ok(2, "pass");

    push @state => {
        count   => state_count()  || 0,
        failed  => state_failed() || 0,
        plan    => state_plan()   || undef,
        ended   => state_ended()  || undef,
        passing => is_passing(),
    };

    ok(0, "fail");
    done_testing;

    push @state => {
        count   => state_count()  || 0,
        failed  => state_failed() || 0,
        plan    => state_plan()   || undef,
        ended   => state_ended()  || undef,
        passing => is_passing(),
    };
};

mostly_like(
    \@state,
    [
        { count => 2, failed => 0, passing => 1, ended => undef },
        { count => 3, failed => 1, passing => 0 },
    ],
    "Verified Test state"
);

events_are(
    [ $state[0]->{plan}, $state[1]->{plan} ],
    check {
        event plan => { max => 3 };
        event plan => { max => 3 };
    },
    "Parts of state that are events check out."
);

isa_ok( $state[1]->{ended}, 'Test::Stream::Context' );

my $got;
my $results = "";
my $utf8 = "";
open( my $fh, ">>", \$results ) || die "Could not open handle to scalar!";
open( my $fh_utf8, ">>", \$utf8 ) || die "Could not open handle to scalar!";

intercept {
    enable_tap(); # Disabled by default in intercept()
    set_tap_outputs( std => $fh, err => $fh, todo => $fh );
    $got = get_tap_outputs();

    ok(1, "pass");

    disable_tap();
    ok(0, "fail");

    enable_tap();
    tap_encoding('utf8');
    set_tap_outputs( encoding => 'utf8', std => $fh_utf8, err => $fh_utf8, todo => $fh_utf8 );
    ok(1, "pass");
    tap_encoding('legacy');

    disable_numbers();
    ok(1, "pass");
    enable_numbers();
    ok(1, "pass");

    subtest_tap_instant();
    subtest foo => sub { ok(1, 'pass') };

    subtest_tap_delayed();
    subtest foo => sub { ok(1, 'pass') };
};

is_deeply(
    $got,
    { encoding => 'legacy', std => $fh, err => $fh, todo => $fh },
    "Got outputs"
);

is( $results, <<EOT, "got TAP output");
ok 1 - pass
ok - pass
ok 5 - pass
# Subtest: foo
    ok 1 - pass
    1..1
ok 6 - foo
ok 7 - foo {
    ok 1 - pass
    1..1
}
EOT

is( $utf8, <<EOT, "got utf8 TAP output");
ok 3 - pass
EOT

done_testing;