This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blob
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
blame
|
history
|
raw
|
HEAD
t/harness can run the tests lib/*.t in parallel with each other.
[perl5.git]
/
t
/
op
/
die_except.t
1
#!./perl
2
3
print "1..12\n";
4
my $test_num = 0;
5
sub ok {
6
print $_[0] ? "" : "not ", "ok ", ++$test_num, "\n";
7
}
8
9
{
10
package End;
11
sub DESTROY { $_[0]->() }
12
sub main::end(&) {
13
my($cleanup) = @_;
14
return bless(sub { $cleanup->() }, "End");
15
}
16
}
17
18
my($val, $err);
19
20
$@ = "t0\n";
21
$val = eval {
22
$@ = "t1\n";
23
1;
24
}; $err = $@;
25
ok $val == 1;
26
ok $err eq "";
27
28
$@ = "t0\n";
29
$val = eval {
30
$@ = "t1\n";
31
do {
32
die "t3\n";
33
};
34
1;
35
}; $err = $@;
36
ok !defined($val);
37
ok $err eq "t3\n";
38
39
$@ = "t0\n";
40
$val = eval {
41
$@ = "t1\n";
42
local $@ = "t2\n";
43
1;
44
}; $err = $@;
45
ok $val == 1;
46
ok $err eq "";
47
48
$@ = "t0\n";
49
$val = eval {
50
$@ = "t1\n";
51
local $@ = "t2\n";
52
do {
53
die "t3\n";
54
};
55
1;
56
}; $err = $@;
57
ok !defined($val);
58
ok $err eq "t3\n";
59
60
$@ = "t0\n";
61
$val = eval {
62
$@ = "t1\n";
63
my $c = end { $@ = "t2\n"; };
64
1;
65
}; $err = $@;
66
ok $val == 1;
67
ok $err eq "";
68
69
$@ = "t0\n";
70
$val = eval {
71
$@ = "t1\n";
72
my $c = end { $@ = "t2\n"; };
73
do {
74
die "t3\n";
75
};
76
1;
77
}; $err = $@;
78
ok !defined($val);
79
ok $err eq "t3\n";
80
81
1;