[perl #125738] CPointer instances created via a native function call that takes a callback argument and has its result assigned to a scalar variable don't have DESTROY called

[via RT]

# New Ticket Created by  Rob Hoelz 
# Please include the string:  [perl #125738]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org/Ticket/Display.html?id=125738 >


See the attached file.

Let's say I have a native function that returns a pointer to a type and takes a 
callback:

    my_struct *create_my_struct(size_t size, void (*error_callback)(error_t 
*error));

...and I call that function via NativeCall, and assign the result to a scalar 
variable:

    class MyStruct is repr('CPointer') {
        my sub create_my_struct(int $size, &error-callback (Error)) returns 
MyStruct is native('mystructlib') { * }

        method new() {
            my $err;
            my $result = create_my_struct(8, -> Error $e { $err = $e.copy });
            $err.throw if $err;
            $result
        }
    }

In that case, the DESTROY finalizer on that pointer is never called.  If I 
assign to a backslash variable:


    my \result = create_my_struct(8, > Error $e { $err = $e.copy });

...DESTROY *is* called.
use v6;
use nqp;

use NativeCall;
use Test;

plan 5;

sub no-op {}

my $blocky-destroyed                   = False;
my $blocky-assigned-destroyed          = False;
my $blocky-assigned-nocont-destroyed = False;
my $plain-destroyed                    = False;
my $plain-assigned-destroyed           = False;

class Blocky is repr('CPointer') {
    # the extra argument shouldn't mess things up on x86/x86_64
    my sub blocky-malloc(int $size, &callback ()) returns Blocky is symbol('malloc') is native(Str) { * }

    method new returns Blocky {
        blocky-malloc(8, -> {})
    }

    submethod DESTROY {
        $blocky-destroyed = True;
    }
}

class BlockyAssigned is repr('CPointer') {
    my sub blocky-malloc(int $size, &callback ()) returns BlockyAssigned is symbol('malloc') is native(Str) { * }

    method new returns BlockyAssigned {
        my $result = blocky-malloc(8, -> {});
        $result
    }

    submethod DESTROY {
        $blocky-assigned-destroyed = True;
    }
}

class BlockyAssignedNocont is repr('CPointer') {
    my sub blocky-malloc(int $size, &callback ()) returns BlockyAssignedNocont is symbol('malloc') is native(Str) { * }

    method new returns BlockyAssignedNocont {
        my \result = blocky-malloc(8, -> {});
        result
    }

    submethod DESTROY {
        $blocky-assigned-nocont-destroyed = True;
    }
}

class Plain is repr('CPointer') {
    my sub malloc(int $size) returns Plain is native(Str) { * }

    method new returns Plain {
        malloc(8)
    }

    submethod DESTROY {
        $plain-destroyed = True;
    }
}

class PlainAssigned is repr('CPointer') {
    my sub malloc(int $size) returns PlainAssigned is native(Str) { * }

    method new returns PlainAssigned {
        my $result = malloc(8);
        $result
    }

    submethod DESTROY {
        $plain-assigned-destroyed = True;
    }
}

my $a = Blocky.new;
my $b = BlockyAssigned.new;
my $c = BlockyAssignedNocont.new;
my $d = Plain.new;
my $e = PlainAssigned.new;

undefine $a;
undefine $b;
undefine $c;
undefine $d;
undefine $e;

nqp::force_gc();

no-op(); # without this, DESTROY doesn't seem to want to trigger on anything

ok $blocky-destroyed, 'DESTROY should be called when a C function gets a Perl 6 callback';
ok $blocky-assigned-destroyed, 'DESTROY should be called when a C function gets a Perl 6 callback and its result is assigned';
ok $blocky-assigned-nocont-destroyed, 'DESTROY should be called when a C function gets a Perl 6 callback and its result is assigned to a \\ varible';
ok $plain-destroyed, q{DESTROY should be called when a C function doesn't get a Perl 6 callback};
ok $plain-assigned-destroyed, q{DESTROY should be callback when a C function doesn't get a Perl 6 callback and its result is assgined};