| File: | blib/lib/Test/Mockingbird/DeepMock.pm |
| Coverage: | 100.0% |
| line | stmt | bran | cond | sub | time | code |
|---|---|---|---|---|---|---|
| 1 | package 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 | ||||||
| 12 | our @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 | ||||||
| 26 | our $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 | ||||||
| 181 | sub 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 | |||||
| 230 | sub _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. | |||||
| 243 | sub _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. | |||||
| 289 | sub _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. | |||||
| 374 | sub _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 | ||||||
| 429 | 1; | |||||