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 IO::Async::Test;

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

use POSIX qw( SIGTERM );

use IO::Async::Signal;

use IO::Async::Loop;
use IO::Async::OS;

plan skip_all => "This OS does not have signals" unless IO::Async::OS->HAVE_SIGNALS;

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

testing_loop( $loop );

my $caught = 0;

my @rargs;

my $signal = IO::Async::Signal->new(
   name => 'TERM',
   on_receipt => sub { @rargs = @_; $caught++ },
);

ok( defined $signal, '$signal defined' );
isa_ok( $signal, "IO::Async::Signal", '$signal isa IO::Async::Signal' );

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

is( $signal->notifier_name, "TERM", '$signal->notifier_name' );

$loop->add( $signal );

is_refcount( $signal, 2, '$signal has refcount 2 after adding to Loop' );

$loop->loop_once( 0.1 ); # nothing happens

is( $caught, 0, '$caught idling' );

kill SIGTERM, $$;

wait_for { $caught };

is( $caught, 1, '$caught after raise' );
is_deeply( \@rargs, [ $signal ], 'on_receipt args after raise' );

my $caught2 = 0;

my $signal2 = IO::Async::Signal->new(
   name => 'TERM',
   on_receipt => sub { $caught2++ },
);

$loop->add( $signal2 );

undef $caught;

kill SIGTERM, $$;

wait_for { $caught };

is( $caught,  1, '$caught after raise' );
is( $caught2, 1, '$caught2 after raise' );

$loop->remove( $signal2 );

undef $caught; undef $caught2;

kill SIGTERM, $$;

wait_for { $caught };

is( $caught,  1,     '$caught after raise' );
is( $caught2, undef, '$caught2 after raise' );

undef $caught;
my $new_caught;
$signal->configure( on_receipt => sub { $new_caught++ } );

kill SIGTERM, $$;

wait_for { $new_caught };

is( $caught, undef, '$caught after raise after replace on_receipt' );
is( $new_caught, 1, '$new_caught after raise after replace on_receipt' );

undef @rargs;

is_refcount( $signal, 2, '$signal has refcount 2 before removing from Loop' );

$loop->remove( $signal );

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

undef $signal;

## Subclass

my $sub_caught = 0;

$signal = TestSignal->new(
   name => 'TERM',
);

ok( defined $signal, 'subclass $signal defined' );
isa_ok( $signal, "IO::Async::Signal", 'subclass $signal isa IO::Async::Signal' );

is_oneref( $signal, 'subclass $signal has refcount 1 initially' );

$loop->add( $signal );

is_refcount( $signal, 2, 'subclass $signal has refcount 2 after adding to Loop' );

$loop->loop_once( 0.1 ); # nothing happens

is( $sub_caught, 0, '$sub_caught idling' );

kill SIGTERM, $$;

wait_for { $sub_caught };

is( $sub_caught, 1, '$sub_caught after raise' );

ok( exception {
      my $signal = IO::Async::Signal->new(
         name => 'this signal name does not exist',
         on_receipt => sub {},
      );
      $loop->add( $signal );
   },
   'Bad signal name fails'
);

done_testing;

package TestSignal;
use base qw( IO::Async::Signal );

sub on_receipt { $sub_caught++ }