Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

259 lines (205 sloc) 5.642 kB
use v6;
use Test;
plan 30;
=begin desc
Tests C<CATCH> blocks.
=end desc
# L<S04/"Exception handlers"/If you define a CATCH block within the try, it replaces the default CATCH>
dies-ok { die 'blah'; CATCH {} }, 'Empty CATCH rethrows exception';
dies-ok { try {die 'blah'; CATCH {}} }, 'CATCH in try overrides default exception handling';
# L<S04/"Exception handlers"/any block can function as a try block if you put a CATCH block within it>
lives-ok { die 'blah'; CATCH {default {}} }, 'Closure with CATCH {default {}} ignores exceptions';
lives-ok { do {die 'blah'; CATCH {default {}}}; }, 'do block with CATCH {default {}} ignores exceptions';
{
my $f = sub { die 'blah'; CATCH {default {}} };
lives-ok $f, 'Subroutine with CATCH {default {}} ignores exceptions';
$f = sub ($x) {
if $x {
die 'blah';
CATCH { default {} }
}
else {
die 'blah';
}
};
lives-ok { $f(1) }, 'if block with CATCH {default {}} ignores exceptions...';
dies-ok { $f(0) }, "...but the CATCH doesn't affect exceptions thrown in an attached else";
}
#L<S04/"Exception handlers"/An exception handler is just a switch statement>
#unless EVAL 'Exception.new' {
# skip_rest "No Exception objects"; exit;
#}
{
# exception classes
class Naughty is Exception {};
my ($not_died, $caught);
{
die Naughty.new();
$not_died = 1;
CATCH {
when Naughty {
$caught = 1;
}
}
};
ok(!$not_died, "did not live after death");
ok($caught, "caught exception of class Naughty");
};
{
# exception superclass
class Naughty::Specific is Naughty {};
class Naughty::Other is Naughty {};
my ($other, $naughty);
{
die Naughty::Specific.new();
CATCH {
when Naughty::Other {
$other = 1;
}
when Naughty {
$naughty = 1;
}
}
};
ok(!$other, "did not catch sibling error class");
ok($naughty, "caught superclass");
};
{
# uncaught class
class Dandy is Exception {};
my ($naughty, $lived);
try {
{
die Dandy.new();
CATCH {
when Naughty {
$naughty = 1;
}
}
};
$lived = 1;
}
ok(!$lived, "did not live past uncaught throw");
ok(!$naughty, "did not get caught by wrong handler");
ok(WHAT($!).gist, '$! is an object');
is(WHAT($!).gist, Dandy.gist, ".. of the right class");
};
{
my $s = '';
{
die 3;
CATCH {
when 1 {$s ~= 'a';}
when 2 {$s ~= 'b';}
when 3 {$s ~= 'c';}
when 4 {$s ~= 'd';}
default {$s ~= 'z';}
}
}
is $s, 'c', 'Caught number';
};
{
my $catches = 0;
sub rt63430 {
{
return 63430;
CATCH { return 73313 if ! $catches++; }
}
}
is rt63430().perl, 63430.perl, 'can call rt63430() and examine the result';
is rt63430(), 63430, 'CATCH does not intercept return from bare block';
is $catches, 0, 'CATCH block never invoked';
};
# L<S04/"Exception handlers"/a CATCH block never attempts to handle any exception thrown within its own dynamic scope>
{
my $catches = 0;
try {
{
die 'catch!';
CATCH { default {die 'caught' if ! $catches++;} }
};
}
is $catches, 1, "CATCH doesn't catch exceptions thrown in its own lexical scope";
$catches = 0;
my $f = { die 'caught' if ! $catches++; };
try {
{
die 'catch!';
CATCH { default {$f()} }
};
}
is $catches, 1, "CATCH doesn't catch exceptions thrown in its own dynamic scope";
my $s = '';
{
die 'alpha';
CATCH {
default {
$s ~= 'a';
die 'beta';
}
CATCH {
default { $s ~= 'b'; }
}
}
};
is $s, 'ab', 'CATCH directly nested in CATCH catches exceptions thrown in the outer CATCH';
$s = '';
{
die 'alpha';
CATCH {
default {
$s ~= 'a';
die 'beta';
CATCH {
default { $s ~= 'b'; }
}
}
}
};
is $s, 'ab', 'CATCH indirectly nested in CATCH catches exceptions thrown in the outer CATCH';
};
# RT #62264
{
try { die "Goodbye cruel world!" };
ok $!.^isa(Exception), '$!.^isa works';
}
# RT #64262
{
dies-ok {
try {
die 1;
CATCH {
default {
die 2;
}
}
}
}, 'can throw exceptions in CATCH';
}
# RT #80864
eval-lives-ok 'my %a; %a{ CATCH { } }', 'can define CATCH bock in .{}';
# RT #73988
eval-dies-ok 'do { CATCH {}; CATCH { } }', 'only one CATCH per block allowed';
# RT #115184
eval-dies-ok 'try { CATCH { ~$! }; die }', "doesn't segfault";
# RT #121213
{
sub failing-routine {
try {
CATCH {
when 'there' {
return False;
}
}
die 'there';
}
}
lives-ok {
failing-routine;
failing-routine;
}, 'Two invocations of a die()ing routine should still hit the CATCH handler';
}
# RT #124191
lives-ok { for ^1000 { die Exception.new; CATCH { default {} } } },
'Hot-path optimization does not break exception handling';
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.