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
|
#!perl
use 5.010;
use strict;
use warnings;
use Gen::Test::Rinci::FuncResult qw(gen_test_func);
use Test::More 0.98;
use Perinci::Sub::Util qw(err);
gen_test_func(func => \&err, name => 'test_err');
package Foo;
sub bar {
my $res = Perinci::Sub::Util::err();
#use Data::Dump; dd $res;
$res;
}
package main;
test_err(
name => 'defaults',
args => [],
status => 500,
message => "(eval) failed",
result => undef,
posttest => sub {
my $res = shift;
is(ref($res->[3]), 'HASH', 'result metadata is hash');
},
);
test_err(
name => 'set status',
args => [400],
status => 400,
);
test_err(
name => 'set message',
args => ["some message"],
status => 500,
message => "some message",
);
test_err(
name => 'set prev',
args => ["some message", 400, [401, "prev error"]],
status => 400,
message => "some message",
posttest => sub {
my $res = shift;
is_deeply($res->[3]{prev}, [401, "prev error"], "prev");
},
);
{
test_err(
name => 'caller',
run => sub { Foo::bar() }, # line 63
status => 500,
message => "Foo::bar failed",
posttest => sub {
my $res = shift;
is($res->[3]{logs}[0]{type}, "create", "log[0] type");
ok($res->[3]{logs}[0]{time}, "log[0] time");
is($res->[3]{logs}[0]{package}, "main", "log[0] package");
is($res->[3]{logs}[0]{func}, "Foo::bar", "log[0] func");
is($res->[3]{logs}[0]{line}, 63, "log[0] line");
},
);
}
{
local %INC = %INC;
$INC{"Carp/Always.pm"} = "test";
my $res1;
test_err(
name => 'stack_trace',
run => sub { Foo::bar() },
status => 500,
posttest => sub {
my $res = shift;
#use Data::Dump; dd $res;
ok($res->[3]{logs}[0]{stack_trace}, "stack_trace");
$res1 = $res;
},
);
test_err(
name => 'stack_trace only produced once',
args => [$res1, 501],
status => 501,
posttest => sub {
my $res = shift;
#use Data::Dump; dd $res;
ok(!$res->[3]{logs}[0]{stack_trace}, "stack_trace");
},
);
}
DONE_TESTING:
done_testing();
|
