File Coverage: blib/lib/Test/Mocha/CalledOk.pm

# File Coverage

File: | blib/lib/Test/Mocha/CalledOk.pm
Coverage: | 100.0%

line | stmt | bran | cond | sub | pod | time | code
--- | --- | --- | --- | --- | --- | --- | ---
1 |  |  |  |  |  |  | package Test::Mocha::CalledOk;
2 |  |  |  |  |  |  | # ABSTRACT: Abstract base class for verifying method calls
3 |  |  |  |  |  |  | # Abstract class methods required of sub-classes: 'is' and 'stringify'
4 |  |  |  |  |  |  | $Test::Mocha::CalledOk::VERSION = '0.61';
5 | 12 12 12 |  |  | 12 |  | 4080 9 229 | use strict;
6 | 12 12 12 |  |  | 12 |  | 21 8 149 | use warnings;
7 |
8 | 12 12 12 |  |  | 12 |  | 24 11 1607 | use Test::Builder;
9 |
10 |  |  |  |  |  |  | my $TB = Test::Builder->new;
11 |
12 |  |  |  |  |  |  | sub test {
13 |  |  |  |  |  |  | # uncoverable pod
14 | 90 |  |  | 90 | 0 | 64 | my ( $class, $method_call, $exp, $test_name ) = @_;
15 |
16 | 90 |  |  |  |  | 105 | my $calls = $method_call->invocant->__calls;
17 | 90 371 90 |  |  |  |  | 65 7079 69 | my $got = grep { $method_call->__satisfied_by($_) } @{$calls};
18 | 90 |  |  |  |  | 938 | my $test_ok = $class->is( $got, $exp );
19 |
20 | 90 |  |  |  |  | 117 | my $exp_times = $class->stringify($exp);
21 | 90 | 100 |  |  |  | 140 | $test_name = "$method_call was called $exp_times" if !defined $test_name;
22 |
23 |  |  |  |  |  |  | # Test failure report should not trace back to Mocha modules
24 | 90 |  |  |  |  | 79 | local $Test::Builder::Level = $Test::Builder::Level + 1;
25 | 90 |  |  |  |  | 112 | $TB->ok( $test_ok, $test_name );
26 |
27 |  |  |  |  |  |  | # output diagnostics to aid with debugging
28 | 90 | 100 | 100 |  |  | 11786 | unless ( $test_ok || $TB->in_todo ) {
29 | 8 |  |  |  |  | 114 | my $call_history;
30 | 8 8 | 100 |  |  |  | 7 9 | if ( @{$calls} ) {
31 | 7 7 |  |  |  |  | 5 17 | $call_history .= "\n " . $_->stringify_long foreach @{$calls};
32 |  |  |  |  |  |  | }
33 |  |  |  |  |  |  | else {
34 | 1 |  |  |  |  | 1 | $call_history = "\n (No methods were called)";
35 |  |  |  |  |  |  | }
36 |
37 | 8 |  |  |  |  | 18 | $TB->diag(<<"END");
38 |  |  |  |  |  |  | Error: unexpected number of calls to '$method_call'
39 |  |  |  |  |  |  | got: $got time(s)
40 |  |  |  |  |  |  | expected: $exp_times
41 |  |  |  |  |  |  | Complete method call history (most recent call last):$call_history
42 |  |  |  |  |  |  | END
43 |  |  |  |  |  |  | }
44 | 90 |  |  |  |  | 494 | return;
45 |  |  |  |  |  |  | }
46 |
47 |  |  |  |  |  |  | 1;