The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# t::SignalHandlerTest
# some global routines to help the testing of
# Signals::XSIG.
##################################################

package t::SignalHandlerTest;
use Exporter;
use Config;
use strict;
use warnings;
our @ISA = qw(Exporter);
our @EXPORT = qw(trigger appropriate_signals alias_pair);

my @no = split ' ', $Config{sig_num};
my @name = split ' ', $Config{sig_name};

# returns some signal names that are appropriate for testing
# on this platform
sub appropriate_signals {
  if (wantarray) {
    if ($^O eq "MSWin32") {
      return qw(INT QUIT);
    } elsif ($^O eq 'freebsd') {
      # are USR1, USR2 not available on freebsd sometimes?
      return qw(USR1 USR2);
    } else {
      return qw(USR1 USR2);
    }
  } else {
    if ($^O eq 'MSWin32') {
      return 'INT';
    } else {
      return 'USR1';
    }
  }
}

# returns a pair of aliased signal names (like CLD and CHLD)
# that is appropriate for this platform
sub alias_pair {
  my @seen = ();
  for (my $i=0; $i<@no; $i++) {
    if ($seen[$no[$i]]) {
      return ($seen[$no[$i]], $name[$i]);
    } else {
      $seen[$no[$i]] = $name[$i];
    }
  }
}

# raise a signal, trying to be platform-independent
sub trigger ($) {
  my ($signal) = @_;
  if ($^O eq "MSWin32" && $signal eq "ALRM") {
    if (0 && $Config{PERL_VERSION} <= 8) {

      # is there a way to trigger a signal handler,
      # any signal handler, on Strawberry 5.8?

      # sleep, alarm may be incompatible
      my $j=0;
      my $t = time + 2;
      alarm 1;
      while (time < $t) {
	$j += rand() - 0.5;
      }
    } elsif (eval { require Time::HiRes; Time::HiRes::alarm(0); 1 }) {
      Time::HiRes::alarm(0.25);
      Time::HiRes::sleep(0.75);
      Time::HiRes::alarm(0);
    } else {
      alarm 1;
      sleep 2;
      alarm 0;
    }
  } else {
    kill $signal, $$;
  }
}

1;