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 | 44 44 44 |  |  | 44 |  | 10386 45 851 | use strict;
6 | 44 44 44 |  |  | 44 |  | 95 39 527 | use warnings;
7 |
8 | 44 44 44 |  |  | 44 |  | 189 31 6582 | use Test::Builder;
9 |
10 |  |  |  |  |  |  | my $TB = Test::Builder->new;
11 |
12 |  |  |  |  |  |  | sub test {
13 |  |  |  |  |  |  | # uncoverable pod
14 | 358 |  |  | 358 | 0 | 297 | my ( $class, $method_call, $exp, $test_name ) = @_;
15 |
16 | 358 |  |  |  |  | 375 | my $calls = $method_call->invocant->__calls;
17 | 358 1481 358 |  |  |  |  | 212 31623 300 | my $got = grep { $method_call->satisfied_by($_) } @{$calls};
18 | 358 |  |  |  |  | 4164 | my $test_ok = $class->is( $got, $exp );
19 |
20 | 358 |  |  |  |  | 467 | my $exp_times = $class->stringify($exp);
21 | 358 | 100 |  |  |  | 552 | $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 | 358 |  |  |  |  | 309 | local $Test::Builder::Level = $Test::Builder::Level + 1;
25 | 358 |  |  |  |  | 484 | $TB->ok( $test_ok, $test_name );
26 |
27 |  |  |  |  |  |  | # output diagnostics to aid with debugging
28 | 358 | 100 | 100 |  |  | 47702 | unless ( $test_ok || $TB->in_todo ) {
29 | 32 |  |  |  |  | 445 | my $call_history;
30 | 32 32 | 100 |  |  |  | 23 42 | if ( @{$calls} ) {
31 | 28 28 |  |  |  |  | 19 60 | $call_history .= "\n " . $_->stringify_long foreach @{$calls};
32 |  |  |  |  |  |  | }
33 |  |  |  |  |  |  | else {
34 | 4 |  |  |  |  | 4 | $call_history = "\n (No methods were called)";
35 |  |  |  |  |  |  | }
36 |
37 | 32 |  |  |  |  | 59 | $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 | 358 |  |  |  |  | 1961 | return;
45 |  |  |  |  |  |  | }
46 |
47 |  |  |  |  |  |  | 1;