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
|
use Contextual::Return;
use Test::More 'no_plan';
use Carp qw< croak cluck confess >;
sub foo {
return
BOOL { cluck 'oops! Bool'; 1 }
NUM { cluck 'oops! Num'; return 7; }
ARRAYREF { cluck 'oops! Array'; return [1,2]; }
HASHREF { {name=>'foo', value=>42 } }
VOID { confess 'Enter not the Abyss!'; }
;
}
sub ok_if_warn {
my ($msg, $line) = @_;
return sub {
# diag( "Caught warning: '@_'" );
ok $_[0] =~ $msg => "Warn msg correct at $line";
ok $_[0] =~ /line $line\Z/ => "Line number correct at $line";
}
}
local $SIG{__WARN__} = ok_if_warn 'oops! Bool', __LINE__+1;
if (my $foo = foo()) {
local $SIG{__WARN__} = ok_if_warn 'oops! Bool', __LINE__+1;
ok +($foo?1:0) => 'BOOLEAN';
local $SIG{__WARN__} = ok_if_warn 'oops! Num', __LINE__+1;
ok "$foo" => 'STRING';
local $SIG{__WARN__} = ok_if_warn 'oops! Array', __LINE__+1;
ok $foo->[0] => 'ARRAYREF';
local $SIG{__WARN__} = sub { ok 0 => "Unexpected warning: @_" };
is $foo->{name}, 'foo' => 'HASHREF (name)';
is $foo->{value}, 42 => 'HASHREF (value)';
}
local $SIG{__WARN__} = ok_if_warn 'oops! Array', __LINE__+1;
my @bar = foo();
ok @bar => 'LIST via ARRAYREF';
my $line = __LINE__+1;
ok !eval { foo(); 1 } => 'VOID is fatal';
like $@, qr/Abyss/ => 'Error message is correct';
like $@, qr/line $line\Z/ => 'Error line is correct';
sub double_or_nothing {
return LIST { 1..9 }
NUM { 10 }
LIST { 11..100 };
}
eval { double_or_nothing(); };
my $exception = $@;
ok $exception => 'Exception on repetition';
like $exception, qr/Can't install two LIST handlers/ => 'Correct exception';
|
