Re: Re: [perl #34524] sv_rvweaken (Scalar::Util::weaken) is inneffective on tied variables

Wed, 20 Jul 2005 01:56:14 -0700

I developped a tool for detecting memory leaks from variables with circular references. (See Devel::Monitor on CPAN). The main use is for mod_perl. I tie variables and print out a message when the variable is destroyed using the DESTROY method. So, using some prints into a log file, I can find out objects that contain circular references. Now that I know which variables create memory leaks, I correct them with a "weaken" on the circular reference instead of using some destructors like XML::DOM or whatever. But, the problem is that I can't verify that the memory leak is corrected since "weaken" doesn't work on a tied variable. Weaken is simply inneffective on the reference. So the only way to be sure that it now works is to test it manually after having removing every tie. I can't monitor memory leaks accurately...
So, what I expect is that "weaken" works on tied variables just like every other variables. 

Forgive my bad english.

Philippe Côté


"Dave Mitchell via RT" <[EMAIL PROTECTED]> wrote :

I'm not really sure what you expect the effect of weakening a tied array
element should be. I suspect that in the general case doing this makes no
sense.



On Mon, Mar 21, 2005 at 08:42:11PM -0000, philippe. cote @ usherbrooke.  
ca wrote:


sv_rvweaken doesn't handle tied variables
Proof :
+-------------------------------------------------------------------------+
Sample code
+-------------------------------------------------------------------------+
#!/usr/bin/perl
use strict;
use warnings;
use Util::Monitor;
use Scalar::Util qw(weaken);
use Devel::Peek;
{
     my (@a);
     $a[0] = [EMAIL PROTECTED];
     #tie @a, 'TestArray';
     Dump($a[0],1);
     weaken($a[0]);
     Dump($a[0],1);
     print "Leaving scope\n";
}
print "Scope left\n";
package TestArray;
use Tie::Array;
use base 'Tie::StdArray';
sub DESTROY { print "Monitor::TestArray::DESTROY : $_[0]\n"; }

1;
+-------------------------------------------------------------------------+
Output without "tie @a, 'TestArray'"
(Just to show you that weaken works without the tie)
+-------------------------------------------------------------------------+
SV = RV(0x81829c0) at 0x814127c
   REFCNT = 1
   FLAGS = (ROK)
   RV = 0x814e740
   SV = PVAV(0x81426cc) at 0x814e740
     REFCNT = 2
     FLAGS = (PADBUSY,PADMY)
     IV = 0
     NV = 0
     ARRAY = 0x8148888
     FILL = 0
     MAX = 3
     ARYLEN = 0x0
     FLAGS = (REAL)
SV = RV(0x81829c0) at 0x814127c
   REFCNT = 1
   FLAGS = (ROK,WEAKREF,IsUV)
   RV = 0x814e740
   SV = PVAV(0x81426cc) at 0x814e740
     REFCNT = 1
     FLAGS = (PADBUSY,PADMY,RMG)
     IV = 0
     NV = 0
     MAGIC = 0x8266f08
       MG_VIRTUAL = &PL_vtbl_backref
       MG_TYPE = PERL_MAGIC_backref(<)
       MG_FLAGS = 0x02
         REFCOUNTED
       MG_OBJ = 0x81411c8
       SV = PVAV(0x8263704) at 0x81411c8
         REFCNT = 2
         FLAGS = ()
         IV = 0
         NV = 0
         ARRAY = 0x82677e8
         FILL = 0
         MAX = 3
         ARYLEN = 0x0
         FLAGS = (REAL)
     ARRAY = 0x8148888
     FILL = 0
     MAX = 3
     ARYLEN = 0x0
     FLAGS = (REAL)
Leaving scope
Scope left
+-------------------------------------------------------------------------+
Output with "tie @a, 'TestArray';"
+-------------------------------------------------------------------------+
SV = PVLV(0x817c568) at 0x81413f0
   REFCNT = 1
   FLAGS = (TEMP,GMG,SMG,RMG)
   IV = 0
   NV = 0
   PV = 0
   MAGIC = 0x81505b8
     MG_VIRTUAL = &PL_vtbl_packelem
     MG_TYPE = PERL_MAGIC_tiedelem(p)
     MG_FLAGS = 0x02
       REFCOUNTED
     MG_OBJ = 0x814139c
     SV = RV(0x81829ac) at 0x814139c
       REFCNT = 2
       FLAGS = (ROK)
       RV = 0x8141354
   TYPE = t
   TARGOFF = 0
   TARGLEN = 0
   TARG = 0x81413f0
SV = PVLV(0x817c568) at 0x81413f0
   REFCNT = 1
   FLAGS = (TEMP,GMG,SMG,RMG)
   IV = 0
   NV = 0
   PV = 0
   MAGIC = 0x81505b8
     MG_VIRTUAL = &PL_vtbl_packelem
     MG_TYPE = PERL_MAGIC_tiedelem(p)
     MG_FLAGS = 0x02
       REFCOUNTED
     MG_OBJ = 0x814139c
     SV = RV(0x81829ac) at 0x814139c
       REFCNT = 2
       FLAGS = (ROK)
       RV = 0x8141354
   TYPE = t
   TARGOFF = 0
   TARGLEN = 0
   TARG = 0x81413f0
Leaving scope
Scope left
Monitor::TestArray::DESTROY : TestArray=ARRAY(0x8141354)
+-------------------------------------------------------------------------+
Explanations
+-------------------------------------------------------------------------+

We see that weaken is not applied on a tied variable. I've been 
searching in source code and calls goes like this :

Scalar::Util::weaken -> sv_rvweaken -> Perl_sv_rvweaken
+-------------------------------------------------------------------------+
Scalar::Util::weaken source code
+-------------------------------------------------------------------------+
void
weaken(sv)
    SV *sv
PROTOTYPE: $
CODE:
#ifdef SvWEAKREF
    sv_rvweaken(sv);
#else

    croak("weak references are not implemented in this release of  
perl");

#endif

We see clearly that it only calls sv_rvweaken from the perl source code. 
So this method doesn't contain bugs.
We also finds that sv_rvweaken is associated to Perl_sv_rvweaken as 
defined by embed.h

Let's look at this code
+-------------------------------------------------------------------------+
Perl_sv_rvweaken source code from sv.c
+-------------------------------------------------------------------------+
/*
=for apidoc sv_rvweaken
Weaken a reference: set the C<SvWEAKREF> flag on this RV; give the
referred-to SV C<PERL_MAGIC_backref> magic if it hasn't already; and
push a back-reference to this RV onto the array of backreferences
associated with that magic.
=cut
*/
SV *
Perl_sv_rvweaken(pTHX_ SV *sv)
{
     SV *tsv;
     if (!SvOK(sv))  /* let undefs pass */
         return sv;
     if (!SvROK(sv))
         Perl_croak(aTHX_ "Can't weaken a nonreference");
     else if (SvWEAKREF(sv)) {
         if (ckWARN(WARN_MISC))

             Perl_warner(aTHX_ packWARN(WARN_MISC), "Reference is 
already weak");

         return sv;
     }
     tsv = SvRV(sv);
     sv_add_backref(tsv, sv);
     SvWEAKREF_on(sv);
     SvREFCNT_dec(tsv);
     return sv;
}
+-------------------------------------------------------------------------+
Conclusion
+-------------------------------------------------------------------------+
The bug is in Perl_sv_rvweaken there :
     if (!SvOK(sv))  /* let undefs pass */
         return sv;
This code should be modified like this :
if (!SvOK(sv))  /* undef var or tied object or something else */
     if (SvMAGIC(sv)) {
         //********************************************/
         //********************************************/
         //********************************************/
         //APPLY WEAKEN HERE (Which I don't know how)
         //********************************************/
         //********************************************/
         //********************************************/
     } else {
         return sv;
     }
}
Thank you
Philippe Cote
Centre de genomique fonctionnelle du Canada






















					Reply via email to