Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

weak refs deleted while target of ref still live?

by patcat88 (Deacon)
on Jul 11, 2011 at 16:53 UTC ( #913727=perlquestion: print w/ replies, xml ) Need Help??
patcat88 has asked for the wisdom of the Perl Monks concerning the following question:

Weak references are deleted BEFORE the DESTROY method of the object they point to runs? parentObj has a hash slice ({'slice'}) that is tied with tobj. During parentObj's DESTROY, {'slice'} is printed. That will tigger the tobj's FETCH. tobj's weak reference to its parent is now gone, while the parent sure is alive because the caller is parentObj's DESTROY and parentObj's DESTROY still sees $self after the read of {'slice'}. There is a weak ref to a ref to a hash (parentObj), its a bug fix for rt://56908.
#!/usr/bin/perl -w use strict; use Data::Dumper; package tobj; use Scalar::Util qw( weaken ); use Data::Dumper; sub TIESCALAR { my $class = shift; my $parentObj = \shift; weaken($parentObj); my $self = {'parent' => $parentObj}; print "tie parent= ".$self->{'parent'}." deref ". ${$self->{'pare +nt'}}."\n"; die " not a parentObj reference" if ! ${$self->{'parent'}}->isa('parentObj'); return bless($self, $class); } sub FETCH { my $self = shift; print "fetch of tobj\n"; print Dumper($self); #print Dumper([[caller 0], [caller 1], [caller 2]]); print "fetch parent= ".$self->{'parent'}." deref "; my $res = eval q!return ${$self->{'parent'}};!; print "eval failed" if !$res; print ((defined($res)?$res:'')." $@\n"); my $result = "tied result data"; return $result; } sub STORE { my $self = shift; } sub DESTROY { print "tobj destory\n"; } package parentObj; use Data::Dumper; sub new { my $class = shift; my $self = {'slice' => '', 'parentdata' => 'some parent data'}; bless($self, $class); tie($self->{'slice'}, 'tobj', $self); return $self; } sub DESTROY { my $self = shift; print "from parentObj's destroy parent data is '".$self->{parentd +ata}."'\n"; print "parentObj's destroy print slice is '".$self->{'slice'}."'\ +n"; } package main; my $parentObj = new parentObj; print "from main, getting parentObj's slice '".$parentObj->{'slic +e'}."'\n"; adxddsad();
C:\Documents and Settings\Owner\Desktop>perl tw.pl tie parent= REF(0x18f0cd4) deref parentObj=HASH(0x3580fc) fetch of tobj $VAR1 = bless( { 'parent' => \bless( { 'parentdata' => 'some parent d +ata', 'slice' => '' }, 'parentObj' ) }, 'tobj' ); fetch parent= REF(0x18f0cd4) deref parentObj=HASH(0x3580fc) from main, getting parentObj's slice 'tied result data' Undefined subroutine &main::adxddsad called at tw.pl line 58. from parentObj's destroy parent data is 'some parent data' fetch of tobj $VAR1 = bless( { 'parent' => \undef }, 'tobj' ); fetch parent= SCALAR(0x18f0cd4) deref eval failed parentObj's destroy print slice is 'tied result data' tobj destory C:\Documents and Settings\Owner\Desktop>
Update. The C callstack to kill_backrefs.
perl512.dll!Perl_sv_kill_backrefs(interpreter * my_perl=0x003542a +4, sv * const sv=0x01903c54, av * const av=0x0182b694) Line 5433 +C perl512.dll!Perl_magic_killbackrefs(interpreter * my_perl=0x00354 +2a4, sv * sv=0x01903c54, magic * mg=0x01822664) Line 2211 + 0x14 +C perl512.dll!Perl_mg_free(interpreter * my_perl=0x003542a4, sv * s +v=0x01903c54) Line 540 + 0x12 C perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * +const sv=0x01903c54) Line 5757 + 0xd C perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * +const sv=0x01903c54) Line 5985 + 0xd C perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * c +onst sv=0x01903c54) Line 5962 + 0xd C perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * +const sv=0x0182b6c4) Line 5686 + 0xd C perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * +const sv=0x0182b6c4) Line 5985 + 0xd C perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * c +onst sv=0x0182b6c4) Line 5962 + 0xd C perl512.dll!Perl_hv_free_ent(interpreter * my_perl=0x003542a4, hv + * hv=0x0182b6a4, he * entry=0x0035f534) Line 1476 + 0xd C perl512.dll!S_hfreeentries(interpreter * my_perl=0x003542a4, hv * + hv=0x0182b6a4) Line 1796 + 0x11 C perl512.dll!Perl_hv_undef(interpreter * my_perl=0x003542a4, hv * +hv=0x0182b6a4) Line 1863 + 0xd C perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * +const sv=0x0182b6a4) Line 5791 + 0xd C perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * +const sv=0x0182b6a4) Line 5985 + 0xd C perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * c +onst sv=0x0182b6a4) Line 5962 + 0xd C perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * +const sv=0x01903ee4) Line 5686 + 0xd C perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * +const sv=0x01903ee4) Line 5985 + 0xd C perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * c +onst sv=0x01903ee4) Line 5962 + 0xd C > perl512.dll!Perl_mg_free(interpreter * my_perl=0x003542a4, sv * s +v=0x00357f6c) Line 548 + 0x10 C perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * +const sv=0x00357f6c) Line 5757 + 0xd C perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * +const sv=0x00357f6c) Line 5985 + 0xd C perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * c +onst sv=0x00357f6c) Line 5962 + 0xd C perl512.dll!Perl_hv_free_ent(interpreter * my_perl=0x003542a4, hv + * hv=0x00357f4c, he * entry=0x0035f4ec) Line 1476 + 0xd C perl512.dll!S_hfreeentries(interpreter * my_perl=0x003542a4, hv * + hv=0x00357f4c) Line 1796 + 0x11 C perl512.dll!Perl_hv_undef(interpreter * my_perl=0x003542a4, hv * +hv=0x00357f4c) Line 1863 + 0xd C perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * +const sv=0x00357f4c) Line 5791 + 0xd C perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * +const sv=0x00357f4c) Line 5985 + 0xd C perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * c +onst sv=0x00357f4c) Line 5962 + 0xd C perl512.dll!do_clean_objs(interpreter * my_perl=0x003542a4, sv * +const ref=0x01903c54) Line 498 + 0xd C perl512.dll!S_visit(interpreter * my_perl=0x003542a4, void (inter +preter *, sv *)* f=0x28149ed0, const unsigned long flags=2048, const +unsigned long mask=2048) Line 440 + 0xb C perl512.dll!Perl_sv_clean_objs(interpreter * my_perl=0x003542a4) + Line 548 + 0x18 C perl512.dll!perl_destruct(interpreter * my_perl=0x003542a4) Line + 770 + 0x9 C perl512.dll!RunPerl(int argc=2, char * * argv=0x00242478, char * +* env=0x00242a20) Line 274 + 0x9 C++ perl.exe!main(int argc=2, char * * argv=0x00242478, char * * env= +0x00242dd0) Line 23 + 0x12 C perl.exe!mainCRTStartup() Line 398 + 0xe C kernel32.dll!_BaseProcessStart@4() + 0x23
update: After spending an hour with Devel::Peek, I noticed I was using a non weak ref, when I though it was a weak ref. I called weaken on a standalone reference, when I shoudlve called weaken on the hash slice 'parent'. Copying, setting, or passing the reference will turn off the weakness. Hard to catch.

Comment on weak refs deleted while target of ref still live?
Select or Download Code
Re: weak refs deleted while target of ref still live?
by ikegami (Pope) on Jul 11, 2011 at 18:36 UTC

    Weak references are deleted BEFORE the DESTROY method of the object they point to runs?

    No.

    $ perl -MScalar::Util=weaken -MDevel::Peek -wE' my $y; sub DESTROY { Dump($y,0); Dump($_[0],1); } { my $x = bless({}); $y = $x; weaken($y); } ' SV = IV(0x99a738c) at 0x99a7390 <-- $y REFCNT = 2 FLAGS = (PADMY,ROK,WEAKREF) <-- Still a reference (ROK) RV = 0x998c768 <-- Still referencing %$x SV = IV(0x998c8a4) at 0x998c8a8 <-- $x REFCNT = 1 FLAGS = (ROK,READONLY) RV = 0x998c768 SV = PVHV(0x99917a8) at 0x998c768 <-- %$x REFCNT = 1 FLAGS = (OBJECT,OOK,SHAREKEYS) STASH = 0x998c658 "main" ARRAY = 0x99a6210 KEYS = 0 FILL = 0 MAX = 7 RITER = -1 EITER = 0x0 BACKREFS = 0x99a7390 <-- %$x is weakly ref-ed by $y SV = IV(0x99a738c) at 0x99a7390 REFCNT = 2 FLAGS = (PADMY,ROK,WEAKREF) RV = 0x998c768

    Sorry, no time to look into your code today.

    Update: I was misusing weaken. Fixed.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://913727]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (10)
As of 2014-10-31 09:28 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (216 votes), past polls