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
121
122
123
124
125
|
#!/usr/bin/env perl
# Test try()
use warnings;
use strict;
use Test::More;
use Log::Report undef, syntax => 'SHORT';
use Carp; # required for tests
eval
{ use POSIX ':locale_h', 'setlocale'; # avoid user's environment
setlocale(LC_ALL, 'POSIX');
};
# start a new logger
my $text = '';
open my($fh), '>', \$text;
dispatcher FILE => 'out', to => $fh, accept => 'NOTICE-', format => sub {shift};
dispatcher close => 'default';
cmp_ok(length $text, '==', 0, 'created normal file logger');
my $text_l1 = length $text;
notice "test";
my $text_l2 = length $text;
cmp_ok($text_l2, '>', $text_l1);
my @l1 = dispatcher 'list';
cmp_ok(scalar(@l1), '==', 1);
is($l1[0]->name, 'out');
try { my @l2 = dispatcher 'list';
cmp_ok(scalar(@l2), '==', 2);
is($l2[1]->name, 'try', 'only try dispatcher');
error "this is an error";
};
my $caught = $@; # be careful with this... Test::More may spoil it.
my @l3 = dispatcher 'list';
cmp_ok(scalar(@l3), '==', 1);
is($l3[0]->name, 'out', 'original dispatcher restored');
isa_ok($caught, 'Log::Report::Dispatcher::Try');
ok($caught->failed);
ok($caught ? 1 : 0);
my @r1 = $caught->exceptions;
cmp_ok(scalar(@r1), '==', 1);
isa_ok($r1[0], 'Log::Report::Exception');
my @r2 = $caught->wasFatal;
cmp_ok(scalar(@r2), '==', 1);
isa_ok($r2[0], 'Log::Report::Exception');
eval {
try { try { failure "oops! no network" };
$@->reportAll;
};
$@->reportAll;
};
like($@, qr[^failure: oops]i);
### context
my $context;
my $scalar = try {
$context = !wantarray && defined wantarray ? 'SCALAR' : 'OTHER';
my @x = 1..10;
@x;
};
is($context, 'SCALAR', 'try in SCALAR context');
cmp_ok($scalar, '==', 10);
try {
$context = !defined wantarray ? 'VOID' : 'OTHER';
3;
};
is($context, 'VOID', 'try in VOID context');
my @list = try {
$context = wantarray ? 'LIST' : 'OTHER';
1..5;
};
is($context, 'LIST', 'try in LIST context');
cmp_ok(scalar @list, '==', 5);
### Bug reported by Andy Beverley 2022-12-17
local $@;
try { report {is_fatal => 1}, INFO => __"oops"; } on_die => 'PANIC';
ok defined($@->wasFatal->message), 'Can reach message';
### convert die/croak/confess
# conversions by Log::Report::Die, see t/*die.t
my $die = try { die "oops" };
ok(ref $@, 'caught die');
isa_ok($@, 'Log::Report::Dispatcher::Try');
my $die_ex = $@->wasFatal;
isa_ok($die_ex, 'Log::Report::Exception');
is($die_ex->reason, 'ERROR');
like("$@", qr[^try-block stopped with ERROR: oops at ] );
my $croak = try { croak "oops2" };
ok(ref $@, 'caught croak');
isa_ok($@, 'Log::Report::Dispatcher::Try');
my $croak_ex = $@->wasFatal;
isa_ok($croak_ex, 'Log::Report::Exception');
is($croak_ex->reason, 'ERROR');
like("$@", qr[^try-block stopped with ERROR: oops2 at ] );
my $confess = try { confess "oops3" };
ok(ref $@, 'caught confess');
isa_ok($@, 'Log::Report::Dispatcher::Try');
my $confess_ex = $@->wasFatal;
isa_ok($confess_ex, 'Log::Report::Exception');
is($confess_ex->reason, 'PANIC');
like("$@", qr[^try-block stopped with PANIC: oops3 at ] );
done_testing;
|
