Bug #121009 for Contextual-Return: leaked references of the caller's arguments

On Fri Apr 07 12:23:07 2017, jkahrman@mathworks.com wrote: Show quoted text
An additional call to 'caller' in a 'DB' package context appears to clear the leaked references. I've attached a patch with this workaround.

--- Contextual-Return-0.004007/lib/Contextual/Return.pm 2016-11-03 00:16:14.000000000 -0400 +++ Contextual-Return-0.004007.patch/lib/Contextual/Return.pm 2016-11-03 00:16:14.000000000 -0400 @@ -248,7 +248,7 @@ # Determine call context and arg list... my $context; - my $args = do { package DB; $context=(CORE::caller 1)[5]; \@DB::args }; + my $args = do { package DB; $context=(CORE::caller 1)[5]; my $args = \@DB::args; ()=CORE::caller(1); $args }; # No args -> return appropriate value... if (!@_) { @@ -287,7 +287,7 @@ *{$subname} = sub(&;@) :lvalue { # (handler, return_lvalue); my $handler = shift; my $impl; - my $args = do{ package DB; ()=CORE::caller(1); \@DB::args }; + my $args = do{ package DB; ()=CORE::caller(1); my $args = \@DB::args; ()=CORE::caller(1); $args }; if (@_==0) { $impl = tie $_[0], 'Contextual::Return::Lvalue', $subname => $handler, args=>$args; @@ -442,7 +442,7 @@ # Ensure we have an object... my $attrs; if (!refaddr $crv) { - my $args = do{ package DB; ()=CORE::caller(1); \@DB::args }; + my $args = do{ package DB; ()=CORE::caller(1); my $args = \@DB::args; ()=CORE::caller(1); $args }; my $subname = (CORE::caller(1))[3]; if (!defined $subname) { $subname = 'bare LIST {...}'; @@ -531,7 +531,7 @@ # Ensure we have an object... my $attrs; if (!refaddr $crv) { - my $args = do{ package DB; ()=CORE::caller(1); \@DB::args }; + my $args = do{ package DB; ()=CORE::caller(1); my $args = \@DB::args; ()=CORE::caller(1); $args }; my $subname = (CORE::caller(1))[3]; if (!defined $subname) { $subname = 'bare VOID {...}'; @@ -650,7 +650,7 @@ # Ensure we have an object... my $attrs; if (!refaddr $crv) { - my $args = do{ package DB; ()=CORE::caller(1); \@DB::args }; + my $args = do{ package DB; ()=CORE::caller(1); my $args = \@DB::args; ()=CORE::caller(1); $args }; my $subname = (CORE::caller(1))[3]; if (!defined $subname) { $subname = "bare $context {...}"; @@ -781,7 +781,7 @@ # Ensure we have an object... my $attrs; if (!refaddr $crv) { - my $args = do{ package DB; ()=CORE::caller(1); \@DB::args }; + my $args = do{ package DB; ()=CORE::caller(1); my $args = \@DB::args; ()=CORE::caller(1); $args }; my $subname = (CORE::caller(1))[3]; if (!defined $subname) { $subname = "bare $context_name {...}";

Jay, Thank-you for investigating and resolving this annoying issue. I am particularly grateful for the patch, which I have now applied and uploaded a new release. Much appreciated! Damian