File Coverage

File:t/06-coverage.t
Coverage:90.8%

linestmtbrancondsubpodtimecode
1
1
1
1
1
3063
2
25
use strict;
2
1
1
1
1
3
1
32
use warnings;
3
1
1
1
1
274
2
48
use Dispatch::Fu;
4
1
1
1
1
416
70626
6
use Test::More;
5
6# Exercise the SCALAR branch of xshift_and_deref.
7
1
65503
my $scalar = q{scalar value};
8
1
2
is xshift_and_deref(\$scalar), $scalar,
9  q{xshift_and_deref dereferences a SCALAR reference};
10
11# Exercise the final fall-through branch for unsupported/non-reference input.
12
1
288
is xshift_and_deref(q{not a reference}), undef,
13  q{xshift_and_deref returns undef for a non-reference};
14
15# A false-but-defined key is a valid static dispatch key.
16
1
293
my $zero;
17
1
1
2
my $zero_result = dispatch { return q{0} } \$zero,
18
1
1
1
6
2
  on 0 => sub { return q{zero} };
19
1
3
is $zero_result, q{zero},
20  q{false-but-defined dispatch key is supported};
21
22# Exercise the non-CODE handler validation path.
23
1
231
my $error = q{};
24
1
1
my $bad_input;
25{
26
1
1
1
1
    local $@;
27
1
1
    eval {
28
1
1
1
4
2
        dispatch { return q{bad} } \$bad_input,
29          on bad => q{not a code reference};
30    };
31
1
3
    $error = $@;
32}
33
1
5
like $error, qr/Computed static bucket "bad" not found/i,
34  q{non-CODE handlers are rejected};
35
36# A failed dispatch must not leak registered handlers into the next call.
37
1
217
my $stale_input;
38{
39
1
1
1
1
    local $@;
40
1
1
    eval {
41
1
1
2
        dispatch { return q{missing} } \$stale_input,
42
1
0
0
5
0
          on stale => sub { return q{stale} };
43    };
44}
45
46
1
2
$error = q{};
47
1
1
my $fresh_input;
48{
49
1
1
6
3
    local $@;
50
1
1
    eval {
51
1
1
1
        dispatch { return q{stale} } \$fresh_input,
52
1
0
0
4
0
          on fresh => sub { return q{fresh} };
53    };
54
1
3
    $error = $@;
55}
56
1
3
like $error, qr/Computed static bucket "stale" not found/i,
57  q{failed dispatch does not leak handlers into the next dispatch};
58
59# Exercise the built-in default handler.  A real case is supplied so this is
60# distinct from the no-cases diagnostic.
61
1
215
my ($warning, $stdout) = (q{}, q{});
62{
63
1
1
1
1
1
5
5
    local $SIG{__WARN__} = sub { $warning .= shift };
64
1
50
10
    open my $capture, '>', \$stdout or die qq{Unable to capture STDOUT: $!};
65
1
2
    local *STDOUT = $capture;
66
67
1
1
    my $default_input;
68
1
1
1
    dispatch { return q{default} } \$default_input,
69
1
0
0
4
0
      on supported => sub { return q{unused} };
70}
71
1
6
like $warning, qr/Supported cases are:/i,
72  q{built-in default handler warns with supported-cases heading};
73
1
217
like $stdout, qr/^\s+default\s*$/m,
74  q{built-in default handler lists the active default case};
75
76# Verify the dispatch table is reset following a successful dispatch.
77
1
212
is_deeply [cases], [q{default}],
78  q{dispatch table resets to its default state after dispatch};
79
80
1
420
done_testing;
81