The above doesn't really reproduce the error as 'FUNC' was in a 'sub' that got called recursively (which triggered the warning).
Also, in that example, it is hard to see when the warning was 'issued', as STDERR is not buffered while STDOUT is, so the warning(on STDERR) would be seen (in this case), before any output from STDOUT (flushed @ program exit).
I've rewritten the code below multiple times to experiment w/outcome. This
reproduces the problem, and shows when an object containing
the 'local' gets destroyed. There are two counters printed -- a
"singleton" counter (1 for package), and a local copy of the
global when the object was created (cuz they aren't the same on
destruction). Hope this doesn't give anyone a headache like
it did me in writing it...;-)
Minor change w/change-line to allow breaking define+assign (i.e. via
the '#' in column 2 (before the code) -- removing or not gets non-split
vs. split define+assign
#!/usr/bin/perl
use warnings; use strict; use P;
{ package pkg; use warnings; use strict; use P; use Types::Core;
our $cnt=0;
sub new { my $p = shift; my $c = ref $p || $p;
Pe "pkg %s created", ++$cnt;
$p = bless { cnt => $cnt, fnc =>
sub { my $p2 = ref $_[0] ? shift : __PACKAGE__;
Pe "fnc %d calling %s", $cnt, $p2->FUNC;
undef;
} }, $c;
}
sub destroy { Pe "pkg %s(%s) destroyed", $cnt, EhV $_[0], cnt; undef
+ }
sub DESTROY { goto &destroy }
}
package main;
sub callfunc(;$$); #silence warn about proto not ready
sub callfunc (;$$) {
my $p = pkg->new;
my ($callfunc, $recur) = @_;
$callfunc||=0; $recur||=0;
local * FUNC
#; *FUNC # change line
= sub () { Pe "In FUNC, cnt=%s", $p->{cnt}; undef };
FUNC() if $callfunc;
callfunc($callfunc, $recur) if $recur && $recur--;
}
Pe "** no recursion";
callfunc;
callfunc 1;
Pe "** split define/assign recursion";
callfunc 0,1;
callfunc 1,1;
pkg::destroy
---output for non-split:---
** no recursion
pkg 1 created
pkg 1(1) destroyed
pkg 2 created
In FUNC, cnt=2
pkg 2(2) destroyed
** split define/assign recursion
pkg 3 created
pkg 4 created
Subroutine main::FUNC redefined at /tmp/tst2.pl line 29.
pkg 4(4) destroyed
pkg 4(3) destroyed
pkg 5 created
In FUNC, cnt=5
pkg 6 created
Subroutine main::FUNC redefined at /tmp/tst2.pl line 29.
In FUNC, cnt=6
pkg 6(6) destroyed
pkg 6(5) destroyed
pkg 6(∄) destroyed
---output for split case ---
** no recursion
pkg 1 created
pkg 1(1) destroyed
pkg 2 created
In FUNC, cnt=2
pkg 2(2) destroyed
** split define/assign recursion
pkg 3 created
pkg 4 created
pkg 4(4) destroyed
pkg 4(3) destroyed
pkg 5 created
In FUNC, cnt=5
pkg 6 created
In FUNC, cnt=6
pkg 6(6) destroyed
pkg 6(5) destroyed
pkg 6(∄) destroyed
I used Types::Core's EhV, to allow dereferencing $_[0] and returning
the value of $_[0] in 1 step. I used P's 'Pe' instead of 'P'
to print to STDERR so my output would be unbuffered and intermixed
with perl's STDERR stream.
Side note: In case your local font doesn't display the default 'undef' sign used by P, (present in parens on the last line of output), it looks like 'E' with a diagonal crossout through it, but backward (in case your font doesn't display it).
As the output shows above, the warning message only occurs on recursive calls to the sub where the local defines the sub (and breaking the local
into a separate declaration followed by the assignment doesn't show the problem....ah crud.. didn't put that in the example -- **UPDATED**
Now we can see that the recursive value gets destroyed before returning
so no overwrite is detected...
p.s. I note the <code> function is broken -- it doesn't post output "as is", but turns it into non-standard, decimal HTML (i.e. &&;#8708 is a decimal number, and current standards default to hex as in "&&;#x2204;" ).
p.p.s. -- I note that while the <code> doesn't maintain literal values
in displaying code, these comments do, so if your charset has the character
it should be between the quotes: "∄".
Cheers!
|