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::Notifier;

{
   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' );

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

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

   my %other;
   no warnings 'redefine';
   local *IO::Async::Notifier::configure_unknown = sub {
      shift;
      %other = @_;
   };

   ok( !exception { $notifier->configure( oranges => 3 ) },
       '$notifier->configure with configure_unknown succeeds' );

   is_deeply( \%other, { oranges => 3 }, '%other after configure_unknown' );
}

# weaseling
{
   my $notifier = IO::Async::Notifier->new;

   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' );

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

# Subclass
{
   my @subargs;
   {
      package TestNotifier;
      use base qw( IO::Async::Notifier );

      sub frobnicate { @subargs = @_ }
   }

   my $subn = TestNotifier->new;

   my $mref = $subn->_capture_weakself( 'frobnicate' );

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

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

   undef @subargs;

   # Method capture
   {
      my @newargs;

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

      $mref->( 321 );

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

   undef @subargs;

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

   undef @subargs;

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

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

   undef @subargs;

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

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

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

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

   undef @subargs;

   is_oneref( $subn, '$subn has refcount 1 finally' );
}

# parent/child
{
   my $parent = IO::Async::Notifier->new;
   my $child = IO::Async::Notifier->new;

   is_oneref( $parent, '$parent has refcount 1 initially' );
   is_oneref( $child, '$child has refcount 1 initially' );

   $parent->add_child( $child );

   is( $child->parent, $parent, '$child->parent is $parent' );
   is_deeply( [ $parent->children ], [ $child ], '$parent->children' );

   is_oneref( $parent, '$parent has refcount 1 after add_child' );
   is_refcount( $child, 2, '$child has refcount 2 after add_child' );

   ok( exception { $parent->add_child( $child ) }, 'Adding child again fails' );

   $parent->remove_child( $child );

   is_oneref( $child, '$child has refcount 1 after remove_child' );
   is_deeply( [ $parent->children ], [], '$parent->children now empty' );
}

# invoke_error
{
   my $parent = IO::Async::Notifier->new;
   my $child = IO::Async::Notifier->new;

   $parent->add_child( $child );

   # invoke_error no handler
   ok( exception { $parent->invoke_error( "It went wrong", wrong => ) },
       'Exception thrown from ->invoke_error with no handler' );

   # invoke_error handler
   my $err;
   $parent->configure( on_error => sub { $err = $_[1] } );

   ok( !exception { $parent->invoke_error( "It's still wrong", wrong => ) },
       'Exception not thrown from ->invoke_error with handler' );
   is( $err, "It's still wrong", '$message to on_error' );

   ok( !exception { $child->invoke_error( "Wrong on child", wrong => ) },
       'Exception not thrown from ->invoke_error on child' );
   is( $err, "Wrong on child", '$message to parent on_error' );
}

done_testing;