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

use strict;
use warnings;
use Test::More 0.88;
use Test::Exception;
use POSIX::RT::Signal -all;
use POSIX qw/sigprocmask SIG_BLOCK SIG_UNBLOCK SIGUSR1 SIGALRM setlocale LC_ALL/;

use Time::HiRes qw/alarm/;

setlocale(LC_ALL, 'C');

{
	my $status = 1;
	my $should_match = 1;
	local $SIG{USR1} = sub { is($status++, $should_match, "status is $should_match") };
	kill SIGUSR1, $$;
	is($status, 2, 'Status is 2');
	$should_match = $status;
	sigqueue($$, 'USR1');
	is($status, 3, 'status is 3');
}

{
	my $sigset = POSIX::SigSet->new(SIGALRM);
	sigprocmask(SIG_BLOCK, $sigset);
	alarm .2;
	ok(!defined sigwaitinfo($sigset, 0.1), 'Nothing yet');

	my $ret = sigwaitinfo('ALRM');
	is(ref $ret, 'HASH', 'Return value is a hash');
	sigprocmask(SIG_UNBLOCK, $sigset);
}

{
	alarm 1;
	my $sigset = POSIX::SigSet->new(SIGUSR1);
	sigprocmask(SIG_BLOCK, $sigset);
	sigqueue($$, SIGUSR1, 42);

	my $info = sigwaitinfo($sigset);
	is($info->{signo}, SIGUSR1, 'Signal numer is USR1');
	is($info->{value}, 42, 'signal value is 42');
	is($info->{pid}, $$, "pid is $$");
	is($info->{uid}, $<, "uid is $<");

	sigqueue($$, SIGUSR1, 42);
	my $signo = sigwait($sigset);
	is($signo, SIGUSR1, 'Got SIGUSR1');
	sigprocmask(SIG_UNBLOCK, $sigset);
}

throws_ok { sigqueue($$, 65536) } qr/Couldn't sigqueue: Invalid argument/, 'sigqueue dies on error in void context';

# Invalid timeval arguments are ignored on FreeBSD
SKIP: { 
	skip 'Invalid arguments to sigwaitinfo are ignored on FreeBSD', 2 if $^O =~ /freebsd/i;
	my $sigset = POSIX::SigSet->new(SIGUSR1);
	throws_ok { sigwaitinfo($sigset, -1) } qr/Couldn't sigwaitinfo: Invalid argument at/, 'sigwaitinfo throws on error in void context';
	lives_ok { sigwaitinfo($sigset, -1) or 1 } 'sigwaitinfo doesn\'t throw on error in scalar context';
}

my $first = allocate_signal();
ok($first, 'Can allocate a signal');
my $second = allocate_signal(1);
cmp_ok($first, '>', $second, 'Priority signal is lower than normal one');
deallocate_signal($first);
is(allocate_signal, $first, 'de- and re-allocating a signal returns the same signal');

done_testing();