weak refs deleted while target of ref still live?

[patcat88]

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.

[ikegami]

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.