Doc examples cause object persistence ... original should work even when not mocked.

[Altreus]

An example showing how to use original ensures that the object never goes out of scope, meaning the package is never restored.

Consider this snippet from the docs:

$mock->redefine("get_path_for", sub {
        my $path = shift;
        if ( $path && $path eq "/a/b/c/d" ) {
                # only alter calls with path set to "/a/b/c/d"
                return $mock->original("get_path_for")->("/my/custom/path");
        } else { # preserve the original arguments
                return $mock->original("get_path_for")->(@_);
        }
});

The subref used to redefine get_path_for closes over $mock. This means that even if $mock goes out of scope in the test, the subref holds onto a reference for it, and is never removed. $mock would need to be weak inside the subref, but I don't know how to do that.

use Test::MockModule;
use REST::Client;
use feature 'say';

{
    my $mock = Test::MockModule->new('REST::Client');
    $mock->mock('GET', sub {
        say "GET called";
        return $mock->original('GET')->(@_);
    });
    REST::Client->new(host => 'http://example.com')->GET('/test');
}

REST::Client->new(host => 'http://example.com')->GET('/test');

▶ perl test.pl
GET called
GET called

My instinct would be to store the original before mocking, and close over that, but this causes an error.

    my $orig = $mock->original('GET');
    $mock->mock('GET', sub {
        say "GET called";
        return $orig->(@_);
    });

It is possible to do it this way, but it does not allow for inheritance:

    my $orig = \&REST::Client::GET;
    $mock->mock('GET', sub {
        say "GET called";
        return $orig->(@_);
    });

▶ perl test.pl
GET called

Ideally, original should not consider it an error for the function not to be mocked.

[Altreus]

I asked how to weaken it properly and that did work:

{
    my $mock = Test::MockModule->new('REST::Client');
    my $mockery = $mock;
    weaken $mockery;
    $mock->mock('GET', sub {
        say "GET called";
        return $mockery->original('GET')->(@_);
    });
    REST::Client->new(host => 'http://example.com')->GET('/test');
}

REST::Client->new(host => 'http://example.com')->GET('/test');

▶ perl test.pl
GET called

But it would be better if original didn't whine :)