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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
use Contextual::Return;
use Carp;
my $FAIL_SPEC_ref;
sub set_up_1 {
package Other;
use Contextual::Return;
use Carp;
$FAIL_SPEC_ref = {
good => sub { BOOL { 0 } DEFAULT { croak 'good'} },
bad => sub { BOOL { 1 } DEFAULT { () } },
ugly => sub { BOOL { undef } DEFAULT { croak 'ugly'} },
};
Contextual::Return::FAIL_WITH $FAIL_SPEC_ref, qw(oh be a good boy);
sub fail_auto_message {
return FAIL;
}
}
set_up_1();
use Test::More qw( no_plan );
sub eval_nok(&$$) {
my ($block, $exception_pat, $message) = @_;
my (undef, $file, $line) = caller;
eval { $block->() };
my $exception = $@;
ok $exception => $message;
like $exception, qr/\Q$exception_pat\E at \Q$file\E line $line/ => "Right message";
}
if ( Other::fail_auto_message() ) {
ok 0 => 'Unexpected succeeded in bool context';
}
else {
ok 1 => 'Failed as expected in bool context';
}
eval_nok { Other::fail_auto_message() } 'good' => 'Exception thrown in void context';
eval_nok { () = Other::fail_auto_message() } 'good' => 'Exception thrown in list context';
eval_nok { my $x = Other::fail_auto_message(); $x+1 } 'good' => 'Exception thrown in num context';
eval_nok { my $x = Other::fail_auto_message(); $x.'a' } 'good' => 'Exception thrown in str context';
sub set_up_2 {
package Other;
my $LINE = (caller)[2];
local $SIG{__WARN__} = sub {
my $message = shift;
::is $message,
'FAIL handler for package Other redefined at '.__FILE__
." line $LINE\n"
=> 'Redefinition warning as expected'
};
Contextual::Return::FAIL_WITH -fail => $FAIL_SPEC_ref, qw(if you fail good -fail bad);
}
set_up_2();
if ( Other::fail_auto_message() ) {
ok 1 => 'Succeeded as expected in bool context';
}
else {
ok 0 => 'Unexpected failed in bool context';
}
my @results = Other::fail_auto_message();
ok @results == 0 => 'Returned empty list in list context';
sub set_up_3 {
package Other;
my $LINE = (caller)[2];
local $SIG{__WARN__} = sub {
my $message = shift;
::is $message,
'FAIL handler for package Other redefined at '.__FILE__
." line $LINE\n"
=> 'Redefinition warning as expected'
};
eval {
Contextual::Return::FAIL_WITH -fail => $FAIL_SPEC_ref, -fail => 'unknown';
};
my $exception = $@;
::ok $exception => "Unknown FAIL handler, as expected";
::like $exception, qr/Invalid option: -fail => unknown/
=> 'Correct exception thrown';
local $SIG{__WARN__} = sub {
my $message = shift;
::is $message,
'FAIL handler for package Other redefined at '.__FILE__
." line $LINE\n"
=> 'Redefinition warning as expected'
};
Contextual::Return::FAIL_WITH -fail => {}, -fail => sub { undef };
}
set_up_3();
if ( Other::fail_auto_message() ) {
ok 0 => 'Unexpected succeeded in bool context';
}
else {
ok 1 => 'Failed as expected in bool context';
}
my $result = Other::fail_auto_message();
ok !defined $result => 'Scalar context was undef';
my @results2 = Other::fail_auto_message();
ok @results2 == 1 => 'Returned one-elem list in list context';
ok !defined $results2[0] => 'One-elem was undef';
|
