stevieb has asked for the wisdom of the Perl Monks concerning the following question:

Hey Monks,

I've read up on Scalar::Util::weaken(), but I can't figure out what exactly I need to do so that my object is DESTROY()ed before END. The output should read foo, baz, foo, but because the object isn't being destroyed before END, I'm getting foo, baz, baz.

I know the problem is with this statement: *One::foo = sub { $self->{x} = 'x'; return "baz\n"; };, because I'm creating a reference to $self within the reference, increasing the REFCNT. Could someone please let me know if weaken() can help here (and how to implement it), or if there's a better way to do this?

Here's my test script:

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

use lib '.';
use Count;

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

[download]

...and a simplified example module (well two, included inside of a single file):

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__;
    }
    $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]

I thought about using copies of the $self variables instead of directly within the sub re-def, but I don't think I can, as the real code is more like this:

        my $count;

        *$sub = sub {
            @{ $self->{called_with} } = @_;
            $self->{called_count} = ++$called;
            if ($self->{side_effect}) {
                if (wantarray){
                    my @effect = $self->{side_effect}->(@_);
                    return @effect if @effect;
                }
                else {
                    my $effect = $self->{side_effect}->(@_);
                    return $effect if defined $effect;
                }
            }

            return undef if ! $self->{return};

            return ! wantarray && @{ $self->{return} } == 1
                ? $self->{return}[0]
                : @{ $self->{return} };
        };

[download]

Replies are listed 'Best First'.
Re: Trying to DESTROY() an object
by Eily (Monsignor) on Dec 08, 2015 at 16:36 UTC

    You never used the word "closure", which makes me think you may not actually get what is happening. In most cases, a lexical is freed (and the reference count decremented if the lexical is a hard ref) at the end of a function call: 

    sub mock 
{
  my $self = shift; # ref count of the object +1
  # code here 
} # $self goes out of scope, ref count of the object -1

    [download]
    But since your new One::foo sub is created inside that lexical scope, it prevents $self from being freed (because the created sub "closes" over it, which means it is a closure that keeps the lexical alive for its own use). 
    sub mock
{
  my $self = shift; # ref count ++
  return sub { $self->{Thing}; };
  # $self is still held by the sub, so it is not freed
}

    [download]
    So this is the reference that you want to weaken, just add weaken $self; just before *One::foo = sub { $self->{x} = 'x'; return "baz\n"; }; and you will get the expected result.

[reply]
[d/l]
[select]

      I'm sorry that I neglected to explain this better. I should have mentioned the closure... I did and do understand what's happening, I've just never been in a position to where I needed to reduce a refcount manually before :)

      I appreciate all the great feedback. I could have sworn I had tried weakening $self, but apparently not because that does the trick and I get the results I'm after.

      Cheers!

      -stevieb

[reply]
[d/l]
      Note Re^3: Trying to DESTROY() an object for a bug in your proposed solution.

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

[reply]
Re: Trying to DESTROY() an object
by kennethk (Abbot) on Dec 08, 2015 at 16:26 UTC
    Update: The problem description below is incorrect, but the design question is still appropriate. See 1149699 for a solution. The problem you are hitting is that there is no guaranteed time for garbage collection. Therefore, garbage collection hasn't happen on the very short time scale for your test.

    For the demo case, the simplest way of getting your desired output would be localizing, e.g., 

    print One::foo();
{
    my $count = Count->new;
    no warnings 'redefine';
    local *One::foo = sub { $count->{x} = 'x'; return "baz\n"; };
    print One::foo();
}
print One::foo();

    [download]
    You could also use mock to bless into a subclass One::Debug that looks like: 
    package One::Debug;
our @ISA = 'One';
sub foo {
    return "baz\n";
}
1;

    [download]
    Really, what's going on here is a bit of an XY Problem. You need to think on how to best encapsulate your patching to cover only your particular problem.

    Incidentally, what you are trying use is traditionally called a guard. At least, I think that's what you are trying to do...

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

[reply]
[d/l]
[select]

      While I agree that there might be a bit of XY under the question, the problem is not because garbage collection does not happen soon enough. Since the closure (the sub reference in *One::foo) holds the $self scalar, the reference count never falls down to 0, so even if stevieb's program ran for a longer period of time, the object would not be garbage collected. Your solution though, by deleting the sub at the end of the scope also happens to delete its hold over the reference, which makes the deletion of the object possible.

[reply]
        Somehow I hadn't grokked that in the scenario that $thing is a Count it gets cached in the sub. That is a problem solvable via weaken by saying 
        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]
        which outputs 
        foo
baz
destroying...
foo

        [download]
        as per the spec. Note that the $closure_self misdirect is necessary because of the Class method invocation: 
        print One::foo();
{
    #my $count = Count->new;
    my $bar = Count->mock;
    print One::foo();
}
print One::foo();

        [download]
        which would yield 
        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]
        Because $self immediately goes out of scope. It's still a weird misdirection since you are localizing a subroutine clobber and not changing an object behavior.

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

[reply]
[d/l]
[select]
      The problem you are hitting is that there is no guaranteed time for garbage collection. Therefore, garbage collection hasn't happen on the very short time scale for your test.

      You must be thinking of some language other than Perl v5. You describe a weakness of many languages. But Perl v5 doesn't have that problem.

      - tye        

[reply]
        Sorry, I neglected to correct that chunk with the rest of the conversation. Updated appropriately.

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

[reply]
Re: Trying to DESTROY() an object
by stevieb (Canon) on Dec 08, 2015 at 18:02 UTC

    For anyone curios, Mock::Sub is what I was working on. It's something that emulates much of Python's unittests.mock.

[reply]

Back to Seekers of Perl Wisdom