在perl中存根并模拟subrotine以进行单元测试

Question

I am trying to do unit testing of the module. I need help and information , how to mock or stub a subroutine to test package.

I do not wish to use the module I came across on cpan.

Answer 1

You an mock subs by overriding them in the following way in your test:

no warnings;
local *Foo::bar = sub {
    # do stuff
};
use warnings;

You typically want to set a variable to be checked later in your test inside your mock.

(even if I suggest using Test::MockModule, but you explicitly specified to not use it)

Answer 2

It's hard to tell what conditions you might have to work around, because you don't give much detail. So this is a general overview of what's involved in mocking subroutines.

Perl stores package subroutines in the symbol table which we can access through "globs" . Take the subroutine do_the_thing in package Some::Package , the last subroutine you assign to the symbol *Some::Package::do_the_thing will replace the normal functionality of that sub. We can also retrieve it so we can have it to call.

my $do_the_original_thing = *Some::Package::do_the_thing{CODE};

Note that to access it, we have to tell it to access the CODE slot of the glob. To replace the sub, we don't. Perl knows to assign code refs to the CODE slot of the glob.

*Some::Package::do_the_thing = sub { 
    if ( $_[0] eq '-reallyreallydoit' and $_[1] ) { 
        shift; shift;
        goto &$do_the_original_thing; # this does not return here
    }
    # do the mock thing
    ...
};

---

NOTE: The way shown demonstrates a minimal way to call a procedure so it acts just like the procedure you're mocking. If you don't like goto , then this does the same thing:

        #goto &$do_the_original_thing; # this does not return here
        return &$do_the_original_thing; # this returns here...to return

However, if you want to test what was returned, or store it to set up future tests, you could simply do it like this:

my $future_test_value ;
*Some::Package::do_the_thing = sub { 
    if ( $_[0] eq '-reallyreallydoit' and $_[1] ) { 
        shift; shift;
        my @res;
        if ( wantarray ) {
            @res = &$do_the_original_thing;
        }
        elsif ( !( wantarray // 1 )) { 
            $res[0] = &$do_the_original_thing;
        }
        $future_test_value = $res[0];
        return wantarray ? @res : $res[0];
    }