File Coverage

File:blib/lib/Test/Mockingbird/DeepMock.pm
Coverage:100.0%

linestmtbrancondsubtimecode
1package Test::Mockingbird::DeepMock;
2
3
6
6
6
1104
6
76
use strict;
4
6
6
6
8
4
109
use warnings;
5
6
6
6
6
7
5
106
use Carp      qw(croak);
7
6
6
6
9
3
52
use Exporter  'import';
8
6
6
6
14
9
40
use Test::Mockingbird        ();
9
6
6
6
675
6
52
use Test::Mockingbird::TimeTravel ();
10
6
6
6
11
2
3237
use Test::More ();
11
12our @EXPORT_OK = qw(deep_mock);
13
14=encoding utf-8
15
16 - 24
=head1 NAME

Test::Mockingbird::DeepMock - Declarative structured mocking and spying for Perl tests

=head1 VERSION

Version 0.14

=cut
25
26our $VERSION = '0.14';
27
28 - 179
=head1 SYNOPSIS

    use Test::Mockingbird::DeepMock qw(deep_mock);

    deep_mock(
        {
            mocks => [
                { target => 'MyApp::greet', type => 'mock', with => sub { 'hi' } },
                { target => 'MyApp::double', type => 'spy', tag => 'double_spy' },
            ],
            expectations => [
                { tag => 'double_spy', calls => 2 },
            ],
        },
        sub {
            is MyApp::greet(), 'hi', 'greet mocked';
            MyApp::double(2);
            MyApp::double(3);
        }
    );

=head1 DESCRIPTION

C<Test::Mockingbird::DeepMock> provides a declarative, data-driven way to
describe mocking, spying, injection, and expectations in Perl tests.

Instead of scattering C<mock>, C<spy>, and C<restore_all> calls throughout
your test code, DeepMock lets you define a complete mocking plan in a single
hashref, then executes your test code under that plan.

=head1 LIMITATIONS

=over 4

=item Nested deep_mock scopes are not supported

C<deep_mock> calls C<restore_all()> on exit, which removes every active mock.
A nested C<deep_mock> call will cause the inner exit to also tear down the
outer mocks.

=item inject type in mocks list

The C<inject> mock type delegates to C<Test::Mockingbird::inject()>. Because
C<inject()> builds a sub that returns the C<with> value verbatim, passing a
coderef via C<with> stores the coderef itself; it is not called on each
access. To inject a factory, wrap it explicitly.

=back

=head1 PLAN STRUCTURE

=head2 C<mocks>

ArrayRef of mock specs. Each entry:

    {
        target => 'Package::method',
        type   => 'mock' | 'spy' | 'inject',
        with   => sub { ... },
        tag    => 'identifier',
    }

=head2 C<expectations>

ArrayRef of expectation specs. Each entry:

    {
        tag        => 'spy_tag',
        calls      => $n,
        args_like  => [ [qr/pat1/, qr/pat2/], ... ],
        args_eq    => [ ['exact', 'args'],    ... ],
        args_deeply => [ [$struct],           ... ],
        never      => 1,
        order      => [ 'A::m1', 'B::m2' ],
    }

The C<order> key is processed after all per-spy expectations and does not
require a C<tag>.

=head2 C<globals>

Optional:

    globals => { restore_on_scope_exit => 1 }

=head2 C<time>

Optional time-travel plan applied before mocks are installed:

    time => {
        freeze  => '2025-01-01T00:00:00Z',
        travel  => '2025-01-03T00:00:00Z',
        advance => [ 2 => 'minutes' ],
        rewind  => [ 1 => 'hour'    ],
    }

=head1 TROUBLESHOOTING

=head2 "Not enough arguments for deep_mock"

DeepMock uses C<($$)> prototype. Use C<deep_mock( {...}, sub { ... } )>.

=head2 My mocks are not restored

Check C<globals => { restore_on_scope_exit => 0 }> has not been set.

=head1 METHODS

=head2 deep_mock

Run a code block with a set of mocks and expectations applied.

=head3 API SPECIFICATION

=head4 Input (Params::Validate::Strict schema)

    $plan -- HashRef with keys: mocks, expectations, globals, time
    $code -- CodeRef

=head4 Output (Returns::Set schema)

    returns: whatever $code returns (context-sensitive)

=head3 MESSAGES

  "deep_mock expects a HASHREF plan" -- first arg is not a hashref

=head3 FORMAL SPECIFICATION

    deep_mock ≙
      âˆ€ plan : HashRef; code : CodeRef •
        pre  ref(plan) = 'HASH'
        post apply_time(plan.time)
             âˆ§ install_mocks(plan.mocks)
             âˆ§ result = code()
             âˆ§ check_expectations(plan.expectations)
             âˆ§ restore_all()

=head3 PSEUDOCODE

    validate plan is HASH
    apply time plan if present
    install each mock/spy/inject from plan.mocks, building %handles
    capture wantarray context
    eval { run $code }
    run expectations against %handles
    restore all mocks (unless restore_on_scope_exit => 0)
    restore time state
    re-croak any exception from $code
    return $code's result in correct context

=cut
180
181sub deep_mock {
182
41
204943
        my ($plan, $code) = @_;
183
184
41
60
        croak 'deep_mock expects a HASHREF plan' unless ref $plan eq 'HASH';
185
186
39
20
        my %handles;
187
188
39
57
        _apply_time_plan($plan->{time});
189
190
39
68
        _install_mocks($plan->{mocks} // [], \%handles);
191
192        # Preserve the caller's context through the eval block
193
35
26
        my $ctx = wantarray;
194
35
19
        my (@list_ret, $scalar_ret, $err);
195
196        {
197
35
35
16
18
                local $@;
198
35
33
                if ($ctx) {
199
2
2
2
2
                        @list_ret   = eval { $code->() };
200                } elsif (defined $ctx) {
201
2
2
2
2
                        $scalar_ret = eval { $code->() };
202                } else {
203
31
31
23
29
                        eval { $code->() };
204                }
205
35
3586
                $err = $@;
206        }
207
208
35
78
        _run_expectations($plan->{expectations} // [], \%handles);
209
210        my $auto_restore = !exists $plan->{globals}{restore_on_scope_exit}
211
34
61
                || $plan->{globals}{restore_on_scope_exit};
212
213
34
51
        Test::Mockingbird::restore_all()           if $auto_restore;
214
34
45
        Test::Mockingbird::TimeTravel::restore_all();
215
216
34
45
        croak $err if $err;
217
218
31
69
        return $ctx ? @list_ret : $scalar_ret;
219}
220
221# _normalize_target -- Private
222#
223# Purpose:      Delegate to Test::Mockingbird::_parse_target.  Kept here as
224#               a thin wrapper so that white-box tests calling
225#               Test::Mockingbird::DeepMock::_normalize_target() continue to
226#               work without requiring updates to those tests.
227# Entry:        $target -- Str, 'Pkg::method' or ('Pkg', 'method')
228# Exit:         ($package, $method)
229# Side effects: none
230sub _normalize_target {
231
53
88408
        return Test::Mockingbird::_parse_target(@_);
232}
233
234# _install_mocks -- Private
235#
236# Purpose:      Install each mock/spy/inject described in the plan and
237#               record spy handles in %handles for later expectation checks.
238# Entry:        $mocks   -- ArrayRef of mock spec hashrefs
239#               $handles -- HashRef to populate with spy/guard handles
240# Exit:         undef
241# Side effects: Modifies symbol tables of target packages.
242#               Populates $handles.
243sub _install_mocks {
244
48
10168
        my ($mocks, $handles) = @_;
245
246
48
29
        my @installed;
247
248
48
38
        for my $m (@$mocks) {
249                my $target = $m->{target}
250
50
71
                        or croak 'mock entry missing target';
251
252
47
38
                my ($pkg, $method) = _normalize_target($target);
253
47
45
                my $full   = "${pkg}::${method}";
254
47
46
                my $type   = $m->{type} // 'mock';
255
256
47
63
                if ($type eq 'mock') {
257                        croak "mock type requires 'with' coderef"
258
20
72
                                unless defined $m->{with} && ref $m->{with} eq 'CODE';
259
260
18
28
                        Test::Mockingbird::mock($pkg, $method, $m->{with});
261
18
21
                        $handles->{ $m->{tag} }{guard} = 1 if $m->{tag};
262
263                } elsif ($type eq 'spy') {
264
18
24
                        my $spy = Test::Mockingbird::spy($pkg, $method);
265
18
41
                        $handles->{ $m->{tag} }{spy} = $spy if $m->{tag};
266
267                } elsif ($type eq 'inject') {
268
5
9
                        Test::Mockingbird::inject($pkg, $method, $m->{with});
269
5
14
                        $handles->{ $m->{tag} }{inject} = 1 if $m->{tag};
270
271                } else {
272
4
23
                        croak "Unknown mock type '$type' for target '$target'";
273                }
274
275
41
46
                push @installed, $full;
276        }
277
278
39
34
        return @installed;
279}
280
281# _run_expectations -- Private
282#
283# Purpose:      Validate recorded spy calls against the plan's expectations.
284#               Handles: calls, args_like, args_eq, args_deeply, never, order.
285# Entry:        $exps    -- ArrayRef of expectation hashrefs
286#               $handles -- HashRef populated by _install_mocks
287# Exit:         undef
288# Side effects: Emits TAP via Test::More.  Croaks on missing tag or spy.
289sub _run_expectations {
290
56
4851
        my ($exps, $handles) = @_;
291
292
56
54
        for my $exp (@$exps) {
293                # order-only entries (no tag) are handled in the second pass below
294
38
82
                next if exists $exp->{order} && !exists $exp->{tag};
295
296                my $tag = $exp->{tag}
297
33
52
                        or croak 'expectation missing tag';
298
299                my $spy = $handles->{$tag}{spy}
300
30
45
                        or croak "no spy handle for tag '$tag'";
301
302
28
29
                my @calls = $spy->();   # [ full_method, @args ]
303
304                # ---- call count -----------------------------------------------
305
28
29
                if (defined $exp->{calls}) {
306                        Test::More::is(scalar @calls, $exp->{calls},
307
18
31
                                "DeepMock: calls for $tag");
308                }
309
310                # ---- args_like (regex matching) --------------------------------
311
28
3067
                if (my $args_like = $exp->{args_like}) {
312
5
7
                        for my $i (0 .. $#$args_like) {
313
8
492
                                my $patterns = $args_like->[$i];
314
8
13
                                my $call     = $calls[$i] // [];
315
8
8
12
8
                                my @args     = @{$call}[1 .. $#$call];
316
8
11
                                for my $j (0 .. $#$patterns) {
317
8
9
                                        my $re = $patterns->[$j];
318
8
37
                                        Test::More::like($args[$j],
319                                                ref $re ? $re : qr/$re/,
320                                                "DeepMock: arg $j call $i of $tag (args_like)");
321                                }
322                        }
323                }
324
325                # ---- args_eq (exact matching) ----------------------------------
326
28
860
                if (my $args_eq = $exp->{args_eq}) {
327
4
8
                        for my $i (0 .. $#$args_eq) {
328
7
519
                                my $expected = $args_eq->[$i];
329
7
12
                                my $call     = $calls[$i] // [];
330
7
7
8
11
                                my @args     = @{$call}[1 .. $#$call];
331
7
10
                                for my $j (0 .. $#$expected) {
332
8
181
                                        Test::More::is($args[$j], $expected->[$j],
333                                                "DeepMock: arg $j call $i of $tag (args_eq)");
334                                }
335                        }
336                }
337
338                # ---- args_deeply (structural) ----------------------------------
339
28
730
                if (my $args_deeply = $exp->{args_deeply}) {
340
3
9
                        require Test::Deep;
341
3
22
                        for my $i (0 .. $#$args_deeply) {
342
6
11053
                                my $expected = $args_deeply->[$i];
343
6
9
                                my $call     = $calls[$i] // [];
344
6
6
7
6
                                my @args     = @{$call}[1 .. $#$call];
345
6
8
                                for my $j (0 .. $#$expected) {
346
6
18
                                        Test::Deep::cmp_deeply($args[$j], $expected->[$j],
347                                                "DeepMock: arg $j call $i of $tag (args_deeply)");
348                                }
349                        }
350                }
351
352                # ---- never (assert zero calls) ---------------------------------
353
28
3357
                if ($exp->{never}) {
354
3
5
                        Test::More::is(scalar @calls, 0, "DeepMock: $tag was never called");
355                }
356        }
357
358        # Second pass: process cross-method order expectations (no tag required)
359
51
616
        for my $exp (@$exps) {
360
33
42
                next unless exists $exp->{order};
361
6
6
4
10
                Test::Mockingbird::assert_call_order(@{ $exp->{order} });
362        }
363
364
51
49
        return;
365}
366
367# _apply_time_plan -- Private
368#
369# Purpose:      Apply a time-travel plan from the deep_mock spec before
370#               installing mocks. All keys are optional.
371# Entry:        $time -- HashRef or undef
372# Exit:         undef
373# Side effects: Activates Test::Mockingbird::TimeTravel if any key is set.
374sub _apply_time_plan {
375
39
26
        my $time = $_[0];
376
39
70
        return unless $time && ref $time eq 'HASH';
377
378        Test::Mockingbird::TimeTravel::freeze_time($time->{freeze})
379
4
12
                if exists $time->{freeze};
380
381        Test::Mockingbird::TimeTravel::travel_to($time->{travel})
382
4
7
                if exists $time->{travel};
383
384
4
4
        if (exists $time->{advance}) {
385
1
1
1
1
                my ($amount, $unit) = @{ $time->{advance} };
386
1
1
                Test::Mockingbird::TimeTravel::advance_time($amount, $unit);
387        }
388
389
4
5
        if (exists $time->{rewind}) {
390
1
1
1
1
                my ($amount, $unit) = @{ $time->{rewind} };
391
1
2
                Test::Mockingbird::TimeTravel::rewind_time($amount, $unit);
392        }
393
394
4
3
        return;
395}
396
397 - 427
=head1 SUPPORT

Please report bugs at L<https://github.com/nigelhorne/Test-Mockingbird/issues>.

=head1 AUTHOR

Nigel Horne, C<< <njh at nigelhorne.com> >>

=head1 SEE ALSO

=over 4

=item * L<Test::Mockingbird>

=item * L<Test::Mockingbird::Async>

=item * L<Test::Mockingbird::TimeTravel>

=back

=head1 REPOSITORY

L<https://github.com/nigelhorne/Test-Mockingbird>

=head1 LICENCE AND COPYRIGHT

Copyright 2026 Nigel Horne.

Usage is subject to GPL2 licence terms.

=cut
428
4291;