BEGIN {
chdir 't' if -d 't';
@INC = '../lib';
+ require './test.pl';
}
use strict;
use Config;
-my $can_catch_kill = 0;
-
-use Test::More tests => 18;
+plan 16;
use_ok( 'sigtrap' );
sigtrap->import('untrapped', 'FAKE');
is( $SIG{FAKE}, 'IGNORE', 'respect existing handler set to IGNORE' );
+fresh_perl_like
+ '
+ BEGIN { *CORE::GLOBAL::kill = sub {} }
+ require sigtrap;
+ import sigtrap "INT";
+ sub { $SIG{INT}->("INT") } -> (3)
+ ',
+ qr/\$ = main::__ANON__\(3\) called/,
+ { stderr => 1 },
+ "stack-trace does not try to modify read-only arguments"
+;
+
my $out = tie *STDOUT, 'TieOut';
$SIG{FAKE} = 'DEFAULT';
$sigtrap::Verbose = 1;
sigtrap->import('any', 'FAKE');
+my $read = $out->read;
+untie *STDOUT;
is( $SIG{FAKE}, \&sigtrap::handler_traceback, 'should set default handler' );
-like( $out->read, qr/^Installing handler/, 'does it talk with $Verbose set?' );
+like( $read, qr/^Installing handler/, 'does it talk with $Verbose set?' );
# handler_die croaks with first argument
eval { sigtrap::handler_die('FAKE') };
like( $@, qr/^Caught a SIGFAKE/, 'does handler_die() croak?' );
-SKIP: {
- skip( 'kill not implemented', 3) unless $can_catch_kill and
- $Config{sig_name} =~ 'ABRT';
-
- $out = tie *STDERR, 'TieOut';
- my $line = __LINE__ + 1;
- eval { sigtrap::handler_traceback('kudra') };
- is( $@, '', 'handler_traceback() should not die' );
- my $trace = $out->read();
- like( $trace, qr/^Caught a SIGkudra/, 'check traceback message' );
- like( $trace, qr/eval.+sigtrap.t.+$line/, 'check trace in traceback' );
-} # end of SKIP
-
package TieOut;
sub TIEHANDLE {