The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More;
use Test::Fatal;
use Test::Refcount;

use IO::Async::Loop;
use IO::Async::Notifier;

my $loop = IO::Async::Loop->new;

is_refcount( $loop, 2, '$loop has refcount 2 initially' );

is_deeply( [ $loop->notifiers ],
           [],
           '$loop->notifiers empty' );

my $notifier = IO::Async::Notifier->new(
   notifier_name => "test1",
);

ok( defined $notifier, '$notifier defined' );
isa_ok( $notifier, "IO::Async::Notifier", '$notifier isa IO::Async::Notifier' );

is_oneref( $notifier, '$notifier has refcount 1 initially' );

is( $notifier->notifier_name, "test1", '$notifier->notifier_name' );

is( $notifier->loop, undef, 'loop undef' );

$loop->add( $notifier );

is_refcount( $loop, 2, '$loop has refcount 2 adding Notifier' );
is_refcount( $notifier, 2, '$notifier has refcount 2 after adding to Loop' );

is( $notifier->loop, $loop, 'loop $loop' );

is_deeply( [ $loop->notifiers ],
           [ $notifier ],
           '$loop->notifiers contains new Notifier' );

ok( exception { $loop->add( $notifier ) }, 'adding again produces error' );

$loop->remove( $notifier );

is( $notifier->loop, undef, '$notifier->loop is undef' );

is_deeply( [ $loop->notifiers ],
           [],
           '$loop->notifiers empty once more' );

ok( !exception { $notifier->configure; },
    '$notifier->configure no params succeeds' );

ok( exception { $notifier->configure( oranges => 1 ) },
    '$notifier->configure an unrecognised parameter fails' );

my @args;
my $mref = $notifier->_capture_weakself( sub { @args = @_ } );

is_oneref( $notifier, '$notifier has refcount 1 after _capture_weakself' );

$mref->( 123 );
is_deeply( \@args, [ $notifier, 123 ], '@args after invoking $mref' );

my @callstack;
$notifier->_capture_weakself( sub {
   my $level = 0;
   push @callstack, [ (caller $level++)[0,3] ] while defined caller $level;
} )->();

is_deeply( \@callstack,
           [ [ "main", "main::__ANON__" ] ],
           'trampoline does not appear in _capture_weakself callstack' );

undef @args;

$mref = $notifier->_replace_weakself( sub { @args = @_ } );

is_oneref( $notifier, '$notifier has refcount 1 after _replace_weakself' );

my $outerself = bless [], "OtherClass";
$mref->( $outerself, 456 );
is_deeply( \@args, [ $notifier, 456 ], '@args after invoking replacer $mref' );

isa_ok( $outerself, "OtherClass", '$outerself unchanged' );

undef @args;

is_refcount( $loop, 2, '$loop has refcount 2 finally' );
is_oneref( $notifier, '$notifier has refcount 1 finally' );

undef $loop;

my @subargs;

$notifier = TestNotifier->new;

$mref = $notifier->_capture_weakself( 'frobnicate' );

is_oneref( $notifier, '$notifier has refcount 1 after _capture_weakself on named method' );

$mref->( 456 );
is_deeply( \@subargs, [ $notifier, 456 ], '@subargs after invoking $mref on named method' );

{
   undef @subargs;
   my @newargs;

   no warnings 'redefine';
   local *TestNotifier::frobnicate = sub { @newargs = @_; };

   $mref->( 321 );

   is_deeply( \@subargs, [], '@subargs empty after TestNotifier::frobnicate replacement' );
   is_deeply( \@newargs, [ $notifier, 321 ], '@newargs after TestNotifier::frobnicate replacement' );
}

undef @subargs;

ok( exception { $notifier->_capture_weakself( 'cannotdo' ) },
    '$notifier->_capture_weakself on unknown method name fails' );

$notifier->invoke_event( 'frobnicate', 78 );
is_deeply( \@subargs, [ $notifier, 78 ], '@subargs after ->invoke_event' );

undef @subargs;

is_deeply( $notifier->maybe_invoke_event( 'frobnicate', 'a'..'c' ),
           [ $notifier, 'a'..'c' ],
           'return value from ->maybe_invoke_event' );

is( $notifier->maybe_invoke_event( 'mangle' ), undef, 'return value from ->maybe_invoke_event on missing event' );

undef @subargs;

my $cb = $notifier->make_event_cb( 'frobnicate' );

is( ref $cb, "CODE", '->make_event_cb returns a CODE reference' );
is_oneref( $notifier, '$notifier has refcount 1 after ->make_event_cb' );

$cb->( 90 );
is_deeply( \@subargs, [ $notifier, 90 ], '@subargs after ->make_event_cb->()' );

isa_ok( $notifier->maybe_make_event_cb( 'frobnicate' ), "CODE", '->maybe_make_event_cb yields CODE ref' );
is( $notifier->maybe_make_event_cb( 'mangle' ), undef, '->maybe_make_event_cb on missing event yields undef' );

undef @subargs;

is_oneref( $notifier, '$notifier has refcount 1 finally' );

done_testing;

package TestNotifier;
use base qw( IO::Async::Notifier );

sub frobnicate { @subargs = @_ }