-
Notifications
You must be signed in to change notification settings - Fork 42
/
die.t
executable file
·78 lines (61 loc) · 2.3 KB
/
die.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
#!perl
use perl5i::latest;
use Test::More;
use File::Temp qw(tempdir tempfile);
use IPC::Open3;
sub run_code {
my $code = shift;
# IPC::Open3, or more specifically waitpid(), will hang on Windows
# if we pass the code in on STDIN. So use a temp file.
my $dir = tempdir("perl5i-turd-XXXX", CLEANUP => 1, TMPDIR => 1);
my($temp_fh, $tempfile) = tempfile(DIR => $dir);
print $temp_fh <<"END";
use lib "lib";
use perl5i::latest;
#line 1 test.plx
$code;
END
close $temp_fh;
#work around for open3 wierdness surrounding lexical filehandles
#and stderr, $err must be true or stderr will go to stdout
my $err = 1;
my $pid = open3 my $in, my $out, $err, $^X, $tempfile
or die "could not execute $^X: $!";
close $in;
waitpid $pid, 0;
# Normalize newlines
binmode $out, ":crlf";
binmode $err, ":crlf";
my $rc = $? >> 8;
my $output = join '', <$out>;
my $error = join '', <$err>;
return ($rc, $output, $error);
}
sub test {
my ($code, $error, $test) = @_;
my ($rc, $out, $err) = run_code $code;
is $rc, 255, "$test exit code";
is $out, "", "$test stdout";
is $err, $error, "$test stderr";
}
test 'die "a noble death"', "a noble death at test.plx line 1.\n", 'normal die';
test 'die "a noble death\n"', "a noble death\n", 'die without line';
test '$! = 5; die "a noble death\n"', "a noble death\n", 'die with $! = 5';
test '$! = 0; $? = 5 << 8; die "a noble death\n"', "a noble death\n", 'die with $! = 0 and $? = 5';
test '$! = 6; $? = 5 << 8; die "a noble death\n"', "a noble death\n", 'die with $! = 6 and $? = 5';
eval { die "oops\n" };
is $@, "oops\n", "die in block eval";
eval { die 1 .. 9, "\n" };
is $@, "123456789\n", "die in block eval with multiple arguments";
eval { die { found => 1 } };
is_deeply $@, { found => 1 }, "die with a reference is unaltered";
{
my $error;
local $SIG{__DIE__} = sub { $error = join '', @_ };
local $! = 0;
eval { die "trigger\n" };
is $error, "trigger\n", "__DIE__ signal handler";
cmp_ok $!, '==', 0, "die() did not set errno";
}
test 'package Foo; die "a noble death\n"', "a noble death\n", 'die in a different package';
done_testing();