Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How can I mock Perl's unlink function?

I want to mock Perl's unlink to test that my code deletes the right files. Based on this question and its answers and this other question and its answers, I tried:

use strict;
use warnings;
use subs 'unlink';
  
sub mock_unlink {
    use Data::Printer; p @_;
    return;
}     

BEGIN {
    no warnings qw/redefine/;
    *CORE::GLOBAL::unlink = \mock_unlink;
    # *unlink = \mock_unlink;
    use warnings;
}
          
unlink "some file";

But when I run this, my mocked function does get called, but the list of arguments is empty. I also get a warning that unlink is undefined.

$ perl mcve.pl
[]
Undefined subroutine &main::unlink called at mcve.pl line 17.

I expected it to print

["some file"]

I've tried the commented out line *unlink = \mock_unlink; instead, but that didn't change anything.

How do I need to mock unlink to check what files my code tries to delete?


Based on zdim's answer, I've tried:

package FooTest;
use strict;
use warnings;
use feature 'say';

BEGIN {
    *CORE::GLOBAL::unlink = sub {
        say "unlinking @_"; 
    };  
}   

Foo::unl('a', 'b', 'c');
1;

package Foo;
use strict;
use warnings;

sub unl {
    unlink @_;
}

1;

and a Foo.pm like here:

package Foo;
use strict;
use warnings;

sub unl {
    unlink @_;
}
    
1;

with this test case

use strict;
use warnings;
use Test::More;

my @unlinked;
    
BEGIN {
    *CORE::GLOBAL::unlink = sub {
        push @unlinked, @_;
    }
}

use Foo;
Foo::unl("some file");
is_deeply(\@unlinked, ["some file"]);
done_testing();

These work as expected, but if I move the use Foo; before the BEGIN block, it does not call the mocked unlink. Why is that happening and do I just need to make sure my imports and BEGINs are in the right order, or is there more to it?

like image 680
Robert Avatar asked Oct 31 '25 03:10

Robert


1 Answers

use strict;
use warnings;
use feature 'say';

#use subs 'unlink';       # doesn't work
#use subs 'mock_unlink';  # this would but do you need it?

sub mock_unlink {
    say "Unlink: @_";
    return;
}

BEGIN {
    no warnings qw/redefine/;
    *CORE::GLOBAL::unlink = \&mock_unlink;
    #use warnings;  # no need, `no warnings` is scoped to this block
}

unlink "some file";

Notes

  • Need \&subname in order to get a reference to a named sub (not \subname)

  • The use subs pragma predeclares the named subs so one can use them without parenthesis even before they are defined. This would work for the new name (mock_unlink) -- but which isn't even intended to be used directly; why bother

  • Why does it not work with use subs unlink;? ... I don't know. Apparently, pre-declaring the sub to be replaced with a differently named one messes with the process. Will update when I find out

  • The use warnings/no warnings are lexical -- the effect expires once the scope is exited. So you don't need to re-enable warnings explicitly (but it is not an error either).

  • The return; in the sub returns undef (scalar context) or an empty list (list context). This mostly indicates a failure of some sort, and it is thus in principle consistent with what unlink returns if it fails to delete ("false").

    This doesn't exactly mimic unlink though, and which also sets $! (see docs). If you want to mock it more tightly consider a bit more.

    Leaving a return out altogether returns the return value from the last statement that has a return, in this case the say that returns true if successful. I find that reasonable as well since this is a test.


According to ikegami's comments,

That would cause uses of unlink to compile into calls to the unlink sub instead of invocations of the unlink operator.

From ikegami's comment,

use Errno qw(ENOENT);

sub mock_unlink { 
    say "Unlink: @_";

    $! = ENOENT; 
    return !!0;
}

Here !!0 produce a canonical false value, in scalar context either an empty string (string context) or a 0 (numerical context), and in a list context an empty list.

like image 149
zdim Avatar answered Nov 01 '25 18:11

zdim



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!