sub mock {
    my $thing = shift;
    my $self;

    if (ref($thing) eq __PACKAGE__){
        $self = $thing;
    }
    else {
        $self = bless {}, __PACKAGE__;
    }
    my $closure_self = $self;
    use Scalar::Util 'weaken';
    weaken $closure_self;

    $self->{sub} = \&One::foo;
    *One::foo = sub { $closure_self->{x} = 'x'; return "baz\n"; };
    return $self;
}
[download]

foo
baz
destroying...
foo
[download]

print One::foo();
{
    #my $count = Count->new;
    my $bar = Count->mock;
    print One::foo();
}
print One::foo();
[download]

foo
Use of uninitialized value in subroutine dereference at script.pl line
+ 31.
destroying...
baz
baz
    (in cleanup) Unable to create sub named "" at script.pl line 31.
[download]

Hello kennethk, You'll have to post a full code for that last output, because I have read your post more than five times and still don't understand the difference between weakening $self or weakening a copy of it.

Because $self immediately goes out of scope.

Well, $self and $closure_self are both lexicals of the same scope, so they both go out of scope at the same time, and the closure can close over any of the two and it shouldn't make any difference. By the way, here under perl v5.20, with my proposed code, I could never reproduce your last output:
main.pl

use warnings;
no warnings 'redefine';
use strict;

use lib '.';
use Count;

print One::foo();
{
    my $bar = Count->mock;
    print One::foo();
}
print One::foo();
[download]

Count.pm

package One;

sub foo {
    return "foo\n";
}
1;

package Count;

use Scalar::Util qw/weaken/; 

sub new {
    return bless {}, shift;
}
sub unmock {
    my $self = shift;
    *One::foo = \&{ $self->{sub} };
}
sub mock {
    my $thing = shift;
    my $self;

    if (ref($thing) eq __PACKAGE__){
        $self = $thing;
    }
    else {
        $self = bless {}, __PACKAGE__;
    }
    
    weaken $self;
    $self->{sub} = \&One::foo;
    *One::foo = sub { $self->{x} = 'x'; return "baz\n"; };
    return $self;
}
sub DESTROY {
    my $self = shift;
    print "destroying...\n";
    $self->unmock;
}
1;
[download]

use warnings;
use strict;

use lib '.';
#use Count;

print One::foo();
{
    #my $count = Count->new;
    my $bar = Count->mock;
    print One::foo();
}
print One::foo();

BEGIN{
package One;

sub foo {
    return "foo\n";
}
1;

package Count;

sub new {
    return bless {}, shift;
}
sub unmock {
    my $self = shift;
    *One::foo = \&{ $self->{sub} };
}
sub mock {
    my $thing = shift;
    my $self;

    if (ref($thing) eq __PACKAGE__){
        $self = $thing;
    }
    else {
        $self = bless {}, __PACKAGE__;
    }
    use Scalar::Util 'weaken';
    weaken $self;

    $self->{sub} = \&One::foo;
    {
        no warnings 'redefine';
        *One::foo = sub { $self->{x} = 'x'; return "baz\n"; };
    }
    return $self;
}
sub DESTROY {
    my $self = shift;
    print "destroying...\n";
    $self->unmock;
}
1;

}
[download]

outputs

foo
Use of uninitialized value in subroutine dereference at script.pl line
+ 30.
destroying...
baz
baz
    (in cleanup) Unable to create sub named "" at script.pl line 30.
[download]

If you weaken $self then you immediately lower the reference count to 0. If you copy $self to $closure_self then you raise the count to 2, then lower it to 1. $self does not go out of scope until after the return, at which point you've passed an external reference to your main block and thus still have a ref count of 1.

I ran your posted code under ActiveState 5.20, and got the output

foo
destroying...
baz
baz
[download]

and if I swap the chunk in question to

    my $closure_self = $self;
    weaken $closure_self;
    $self->{sub} = \&One::foo;
    *One::foo = sub { $closure_self->{x} = 'x'; return "baz\n"; };
    return $self;
[download]

I get

foo
baz
destroying...
foo
[download]

Your code cannot restore the old function, because your object was out of scope before your assignment. This could be demonstrated by using Data::Dump in DESTROY:

sub DESTROY {
    use Data::Dump;
    my $self = shift;
    print "destroying...\n";
    print dd($self), "\n";
    $self->unmock;
}
[download]

which, for your code, outputs

foo
destroying...
bless({}, "Count")
1
baz
baz
[download]

and for mine

foo
baz
destroying...
bless({ sub => sub { ... }, x => "x" }, "Count")
1
foo
[download]

You will also note you'll start getting the errors and warnings I posted if you put strict and warnings in your modules instead of just in your script.

This all raises the point that unmock is actually written terribly, because it creates a whole additional closure about $self. It should really be

sub unmock {
    my $self = shift;
    *One::foo = $self->{sub};
}
[download]

so that you restore the original sub reference.

---

#11929 First ask yourself `How would I do this without a computer?' Then have the computer do it the same way.

Thanks kennethk.

I also found that instead of doing the object redirect, I can weaken() inside of the sub re-definition on $self directly:

*$sub = sub {
    weaken $self if ! isweak $self;
    ...
}
[download]

I've been doing some testing with both scenarios to see if without the $closure_self, weird issues crop up.

I don't think that does what you want. The reference will never be weakened if you never call sub.
Read more... (1356 Bytes)

---

#11929 First ask yourself `How would I do this without a computer?' Then have the computer do it the same way.