sv_rvweaken (Scalar::Util::weaken) is inneffective on tied variables

Mon, 21 Mar 2005 12:25:34 -0800 

Hi,

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 Côté
Centre de génomique fonctionnelle du Canada

I'm using perl 5.8.6

Reply via email to