Commit | Line | Data |
---|---|---|
d1b75174 | 1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
7cba3dc7 | 6 | require './test.pl'; |
d1b75174 | 7 | } |
8 | ||
9 | use strict; | |
10 | use Config; | |
11 | ||
7728d0a5 | 12 | plan 16; |
d1b75174 | 13 | |
14 | use_ok( 'sigtrap' ); | |
15 | ||
16 | package main; | |
17 | local %SIG; | |
18 | ||
19 | # use a version of sigtrap.pm somewhat too high | |
20 | eval{ sigtrap->import(99999) }; | |
21 | like( $@, qr/version 99999 required,/, 'import excessive version number' ); | |
22 | ||
23 | # use an invalid signal name | |
24 | eval{ sigtrap->import('abadsignal') }; | |
25 | like( $@, qr/^Unrecognized argument abadsignal/, 'send bad signame to import' ); | |
26 | ||
27 | eval{ sigtrap->import('handler') }; | |
28 | like( $@, qr/^No argument specified/, 'send handler without subref' ); | |
29 | ||
30 | sigtrap->import('AFAKE'); | |
31 | is( $SIG{AFAKE}, \&sigtrap::handler_traceback, 'install normal handler' ); | |
32 | ||
33 | sigtrap->import('die', 'AFAKE', 'stack-trace', 'FAKE2'); | |
34 | is( $SIG{AFAKE}, \&sigtrap::handler_die, 'install the die handler' ); | |
35 | is( $SIG{FAKE2}, \&sigtrap::handler_traceback, 'install traceback handler' ); | |
36 | ||
37 | my @normal = qw( HUP INT PIPE TERM ); | |
38 | @SIG{@normal} = 1 x @normal; | |
39 | sigtrap->import('normal-signals'); | |
40 | is( (grep { ref $_ } @SIG{@normal}), @normal, 'check normal-signals set' ); | |
41 | ||
42 | my @error = qw( ABRT BUS EMT FPE ILL QUIT SEGV SYS TRAP ); | |
43 | @SIG{@error} = 1 x @error; | |
44 | sigtrap->import('error-signals'); | |
45 | is( (grep { ref $_ } @SIG{@error}), @error, 'check error-signals set' ); | |
46 | ||
47 | my @old = qw( ABRT BUS EMT FPE ILL PIPE QUIT SEGV SYS TERM TRAP ); | |
48 | @SIG{@old} = 1 x @old; | |
49 | sigtrap->import('old-interface-signals'); | |
50 | is( (grep { ref $_ } @SIG{@old}), @old, 'check old-interface-signals set' ); | |
51 | ||
52 | my $handler = sub {}; | |
53 | sigtrap->import(handler => $handler, 'FAKE3'); | |
54 | is( $SIG{FAKE3}, $handler, 'install custom handler' ); | |
55 | ||
56 | $SIG{FAKE} = 'IGNORE'; | |
57 | sigtrap->import('untrapped', 'FAKE'); | |
58 | is( $SIG{FAKE}, 'IGNORE', 'respect existing handler set to IGNORE' ); | |
59 | ||
0ec7d39d FC |
60 | fresh_perl_like |
61 | ' | |
62 | BEGIN { *CORE::GLOBAL::kill = sub {} } | |
63 | require sigtrap; | |
64 | import sigtrap "INT"; | |
65 | sub { $SIG{INT}->("INT") } -> (3) | |
66 | ', | |
67 | qr/\$ = main::__ANON__\(3\) called/, | |
68 | { stderr => 1 }, | |
7728d0a5 FC |
69 | "stack-trace does not try to modify read-only arguments" |
70 | ; | |
71 | ||
d1b75174 | 72 | my $out = tie *STDOUT, 'TieOut'; |
73 | $SIG{FAKE} = 'DEFAULT'; | |
74 | $sigtrap::Verbose = 1; | |
75 | sigtrap->import('any', 'FAKE'); | |
aa0aae57 FC |
76 | my $read = $out->read; |
77 | untie *STDOUT; | |
d1b75174 | 78 | is( $SIG{FAKE}, \&sigtrap::handler_traceback, 'should set default handler' ); |
aa0aae57 | 79 | like( $read, qr/^Installing handler/, 'does it talk with $Verbose set?' ); |
d1b75174 | 80 | |
81 | # handler_die croaks with first argument | |
82 | eval { sigtrap::handler_die('FAKE') }; | |
83 | like( $@, qr/^Caught a SIGFAKE/, 'does handler_die() croak?' ); | |
84 | ||
d1b75174 | 85 | package TieOut; |
86 | ||
87 | sub TIEHANDLE { | |
88 | bless(\(my $scalar), $_[0]); | |
89 | } | |
90 | ||
91 | sub PRINT { | |
92 | my $self = shift; | |
93 | $$self .= join '', @_; | |
94 | } | |
95 | ||
96 | sub WRITE { | |
97 | my ($self, $msg, $length) = @_; | |
98 | $$self .= $msg; | |
99 | } | |
100 | ||
101 | sub read { | |
102 | my $self = shift; | |
103 | substr($$self, 0, length($$self), ''); | |
104 | } |