xref: /openbsd-src/gnu/usr.bin/perl/cpan/Test-Simple/t/Test2/modules/Event/Generic.t (revision f3efcd0145415b7d44d9da97e0ad5c21b186ac61)

use strict;
use warnings;

use Test2::Tools::Tiny;
use Test2::EventFacet::Trace;

use Test2::API qw/context intercept/;

sub tool {
    my $ctx = context();
    my $e = $ctx->send_event('Generic', @_);
    $ctx->release;
    return $e;
}

my $e;
intercept { $e = tool() };

ok($e,                               "got event");
ok($e->isa('Test2::Event'),          "It is an event");
ok($e->isa('Test2::Event::Generic'), "It is an event");
delete $e->{trace};
is_deeply(
    $e,
    {
        causes_fail      => 0,
        increments_count => 0,
        diagnostics      => 0,
        no_display       => 0,
        _eid             => $e->eid,
        hubs             => [
            {
                'buffered' => 0,
                'details'  => 'Test2::Hub::Interceptor',
                'hid'      => $e->hubs->[0]->{hid},
                'ipc'      => 0,
                'nested'   => 0,
                'pid'      => $$,
                'tid'      => 0,
                $e->hubs->[0]->{uuid} ? (uuid => $e->hubs->[0]->{uuid}) : (uuid => undef),
            }
        ],
        $e->uuid ? (uuid => $e->uuid) : (),
    },
    "Defaults"
);

for my $f (qw/causes_fail increments_count diagnostics no_display/) {
    is($e->$f, 0, "'$f' is 0");
    is_deeply([$e->$f], [0], "'$f' is 0 is list context as well");

    my $set = "set_$f";
    $e->$set(1);
    is($e->$f, 1, "'$f' was set to 1");
}

for my $f (qw/callback terminate global sets_plan/) {
    is($e->$f, undef, "no $f");
    is_deeply([$e->$f], [], "$f is empty in list context");
}

like($e->summary, qr/Test2::Event::Generic/, "Got base class summary");

like(
    exception { $e->set_sets_plan('bad') },
    qr/'sets_plan' must be an array reference/,
    "Must provide an arrayref"
);

$e->set_sets_plan([0, skip => 'cause']);
is_deeply([$e->sets_plan], [0, skip => 'cause'], "sets_plan returns a list, not a ref");
$e->set_sets_plan(undef);
ok(!exists $e->{sets_plan}, "Removed sets_plan key");
ok(!$e->sets_plan, "sets_plan is cleared");

$e->set_global(0);
is($e->global, 0, "global is off");
$e->set_global(1);
is($e->global, 1, "global is on");
$e->set_global(0);
is($e->global, 0, "global is again");
$e->set_global(undef);
ok(!exists $e->{global}, "removed global key");
is($e->global, undef, "global is not defined");

like(
    exception { $e->set_callback('dogfood') },
    qr/callback must be a code reference/,
    "Callback must be code"
);

my $ran = 0;
$e->set_callback(sub {
    $ran++;
    my $self = shift;
    is($self, $e, "got self");
    is_deeply( \@_, ['a', 'b', 'c'], "Got args" );
    return 'foo';
});
is($e->callback('a', 'b', 'c'), 'foo', "got callback's return");
ok($ran, "ran callback");

$e->set_callback(undef);
ok(!$e->callback, "no callback");
ok(!exists $e->{callback}, "no callback key");

like(
    exception { $e->set_terminate('1.1') },
    qr/terminate must be a positive integer/,
    "terminate only takes integers"
);

like(
    exception { $e->set_terminate('foo') },
    qr/terminate must be a positive integer/,
    "terminate only takes numbers"
);

like(
    exception { $e->set_terminate('-1') },
    qr/terminate must be a positive integer/,
    "terminate only takes positive integers"
);

$e->set_terminate(0),
is($e->terminate, 0, "set to 0, 0 is valid");
$e->set_terminate(1),
is($e->terminate, 1, "set to 1");
$e->set_terminate(123),
is($e->terminate, 123, "set to 123");
$e->set_terminate(0),
is($e->terminate, 0, "set to 0, 0 is valid");

$e->set_terminate(undef);
is($e->terminate, undef, "terminate is not defined");
ok(!exists $e->{terminate}, "no terminate key");

# Test constructor args
intercept { $e = tool(causes_fail => 1, increments_count => 'a') };
is($e->causes_fail, 1, "attr from constructor");
is($e->increments_count, 'a', "attr from constructor");

done_testing;