r15577 - in /trunk/libclone-perl: Changes Clone.pm Clone.xs META.yml Makefile.PL debian/changelog t/06refcnt.t t/07magic.t

gregoa-guest at users.alioth.debian.org gregoa-guest at users.alioth.debian.org
Sun Feb 24 23:53:07 UTC 2008


Author: gregoa-guest
Date: Sun Feb 24 23:53:05 2008
New Revision: 15577

URL: http://svn.debian.org/wsvn/?sc=1&rev=15577
Log:
New upstream releases, builds also with Perl 5.10 (closes: #463099).

Modified:
    trunk/libclone-perl/Changes
    trunk/libclone-perl/Clone.pm
    trunk/libclone-perl/Clone.xs
    trunk/libclone-perl/META.yml
    trunk/libclone-perl/Makefile.PL
    trunk/libclone-perl/debian/changelog
    trunk/libclone-perl/t/06refcnt.t
    trunk/libclone-perl/t/07magic.t

Modified: trunk/libclone-perl/Changes
URL: http://svn.debian.org/wsvn/trunk/libclone-perl/Changes?rev=15577&op=diff
==============================================================================
--- trunk/libclone-perl/Changes (original)
+++ trunk/libclone-perl/Changes Sun Feb 24 23:53:05 2008
@@ -1,6 +1,25 @@
 Revision history for Perl extension Clone.
 
 $Log: Changes,v $
+Revision 0.26  2007-10-15 04:52:42  ray
+Made a change in CLONE_KEY to the way Clone stores refs in the ref hash.
+Perl no longer uses the SvANY part of the SV struct in the same way which
+meams the old way of storing the hash key is no longer unique.
+Thanks to Slaven Rezic for the patch.
+
+Revision 0.25  2007-07-25 03:41:04  ray
+Latest patch from Ruslan Zakirov. Patched another memory leak.
+
+Revision 0.24  2007-07-25 03:33:57  ray
+Bug fix for 5.9.*, for some reason the 'visible' logic is no longer working.
+I #if 'ed it out until I figure out what is going on.
+Also removed an old redundant CLONE_STORE, could have been the cause of some
+memory leaks.
+
+Revision 0.23  2007-04-20 05:40:27  ray
+Applied patch so clone will contiue to work with newer perls.
+Also fixed test to work with older perls.
+
 Revision 0.22  2006-10-08 05:35:19  ray
 D'oh! The 0.21 tardist that I just uploaded to CPAN contained the 0.20 Clone.xs file. This release is just in case any of the 0.21 releases get mirrored.
 

Modified: trunk/libclone-perl/Clone.pm
URL: http://svn.debian.org/wsvn/trunk/libclone-perl/Clone.pm?rev=15577&op=diff
==============================================================================
--- trunk/libclone-perl/Clone.pm (original)
+++ trunk/libclone-perl/Clone.pm Sun Feb 24 23:53:05 2008
@@ -1,4 +1,4 @@
-# $Id: Clone.pm,v 0.22 2006-10-08 05:35:19 ray Exp $
+# $Id: Clone.pm,v 0.28 2007-10-15 04:52:42 ray Exp $
 package Clone;
 
 use strict;
@@ -16,7 +16,7 @@
 @EXPORT = qw();
 @EXPORT_OK = qw( clone );
 
-$VERSION = '0.22';
+$VERSION = '0.28';
 
 bootstrap Clone $VERSION;
 

Modified: trunk/libclone-perl/Clone.xs
URL: http://svn.debian.org/wsvn/trunk/libclone-perl/Clone.xs?rev=15577&op=diff
==============================================================================
--- trunk/libclone-perl/Clone.xs (original)
+++ trunk/libclone-perl/Clone.xs Sun Feb 24 23:53:05 2008
@@ -4,9 +4,9 @@
 #include "perl.h"
 #include "XSUB.h"
 
-static char *rcs_id = "$Id: Clone.xs,v 0.21 2006-10-08 04:02:56 ray Exp $";
-
-#define CLONE_KEY(x) ((char *) x) 
+static char *rcs_id = "$Id: Clone.xs,v 0.27 2007-10-15 04:52:42 ray Exp $";
+
+#define CLONE_KEY(x) ((char *) &x) 
 
 #define CLONE_STORE(x,y)						\
 do {									\
@@ -75,8 +75,10 @@
 
   TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref)));
 
-  if (SvREFCNT(ref) > 1)
-    CLONE_STORE(ref, (SV *)clone);
+  /* The following is a holdover from a very old version */
+  /* possible cause of memory leaks */
+  /* if ( (SvREFCNT(ref) > 1) ) */
+  /*   CLONE_STORE(ref, (SV *)clone); */
 
   arrlen = av_len (self);
   av_extend (clone, arrlen);
@@ -97,7 +99,6 @@
 {
   SV *clone = NULL;
   SV *rv = NULL;
-  UV visible = (SvREFCNT(ref) > 1);
 
   assert(SvROK(ref));
 
@@ -123,7 +124,13 @@
 {
   SV *clone = ref;
   SV **seen = NULL;
-  UV visible = (SvREFCNT(ref) > 1);
+#if PERL_REVISION >= 5 && PERL_VERSION > 8
+  /* This is a hack for perl 5.9.*, save everything */
+  /* until I find out why mg_find is no longer working */
+  UV visible = 1;
+#else
+  UV visible = (SvREFCNT(ref) > 1) || (SvMAGICAL(ref) && mg_find(ref, '<'));
+#endif
   int magic_ref = 0;
 
   TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref)));
@@ -152,10 +159,7 @@
         break;
       case SVt_RV:		/* 3 */
         TRACEME(("ref scalar\n"));
-        clone = NEWSV(1002, 0);
-        sv_upgrade(clone, SVt_RV);
-	/* move the following to SvROK section below */
-        /* SvROK_on(clone); */
+        clone = newSVsv (ref);
         break;
       case SVt_PV:		/* 4 */
         TRACEME(("string scalar\n"));
@@ -177,7 +181,9 @@
       case SVt_PVHV:	/* 11 */
         clone = (SV *) newHV();
         break;
+      #if PERL_VERSION <= 8
       case SVt_PVBM:	/* 8 */
+      #endif
       case SVt_PVLV:	/* 9 */
       case SVt_PVCV:	/* 12 */
       case SVt_PVGV:	/* 13 */
@@ -271,12 +277,15 @@
     /* 3: REFERENCE (inlined for speed) */
   else if (SvROK (ref))
     {
-      SvROK_on(clone);  /* only set if ROK is set if ref */
       TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));
+      SvREFCNT_dec(SvRV(clone));
       SvRV(clone) = sv_clone (SvRV(ref), depth); /* Clone the referent */
       if (sv_isobject (ref))
       {
           sv_bless (clone, SvSTASH (SvRV (ref)));
+      }
+      if (SvWEAKREF(ref)) {
+          sv_rvweaken(clone);
       }
     }
 

Modified: trunk/libclone-perl/META.yml
URL: http://svn.debian.org/wsvn/trunk/libclone-perl/META.yml?rev=15577&op=diff
==============================================================================
--- trunk/libclone-perl/META.yml (original)
+++ trunk/libclone-perl/META.yml Sun Feb 24 23:53:05 2008
@@ -1,7 +1,7 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Clone
-version:      0.22
+version:      0.28
 version_from: Clone.pm
 installdirs:  site
 requires:

Modified: trunk/libclone-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/trunk/libclone-perl/Makefile.PL?rev=15577&op=diff
==============================================================================
--- trunk/libclone-perl/Makefile.PL (original)
+++ trunk/libclone-perl/Makefile.PL Sun Feb 24 23:53:05 2008
@@ -1,5 +1,5 @@
 use ExtUtils::MakeMaker;
-# $Id: Makefile.PL,v 0.18 2006-10-08 03:37:20 ray Exp $
+# $Id: Makefile.PL,v 0.19 2007-10-15 04:57:20 ray Exp $
 # See lib/ExtUtils/MakeMaker.pm for details of how to influence
 # the contents of the Makefile that is written.
 WriteMakefile(
@@ -10,5 +10,6 @@
     'INC'	=> '',     # e.g., '-I/usr/include/other' 
 #    'OPTIMIZE'	=> '-g',     # e.g., '-I/usr/include/other' 
     'OPTIMIZE'	=> '-O3',     # e.g., '-I/usr/include/other' 
+    clean => {FILES => '_Inline'},
 );
 

Modified: trunk/libclone-perl/debian/changelog
URL: http://svn.debian.org/wsvn/trunk/libclone-perl/debian/changelog?rev=15577&op=diff
==============================================================================
--- trunk/libclone-perl/debian/changelog (original)
+++ trunk/libclone-perl/debian/changelog Sun Feb 24 23:53:05 2008
@@ -1,4 +1,4 @@
-libclone-perl (0.22-2) UNRELEASED; urgency=low
+libclone-perl (0.28-1) UNRELEASED; urgency=low
 
   * Take over for the Debian Perl Group with former maintainer's permission
     (cf. #463099).
@@ -9,8 +9,9 @@
     <waldi at debian.org>).
   * debian/watch: use dist-based URL.
   * debian/rules: delete /usr/share/perl5 only if it exists.
+  * New upstream releases, builds also with Perl 5.10 (closes: #463099).
 
- -- gregor herrmann <gregor+debian at comodo.priv.at>  Mon, 25 Feb 2008 00:50:07 +0100
+ -- gregor herrmann <gregor+debian at comodo.priv.at>  Mon, 25 Feb 2008 00:51:57 +0100
 
 libclone-perl (0.22-1) unstable; urgency=low
 

Modified: trunk/libclone-perl/t/06refcnt.t
URL: http://svn.debian.org/wsvn/trunk/libclone-perl/t/06refcnt.t?rev=15577&op=diff
==============================================================================
--- trunk/libclone-perl/t/06refcnt.t (original)
+++ trunk/libclone-perl/t/06refcnt.t Sun Feb 24 23:53:05 2008
@@ -1,4 +1,4 @@
-# $Id: 06refcnt.t,v 0.18 2006-10-08 03:37:29 ray Exp $
+# $Id: 06refcnt.t,v 0.22 2007-07-25 03:41:06 ray Exp $
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
 
@@ -7,7 +7,7 @@
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
-BEGIN { $| = 1; print "1..9\n"; }
+BEGIN { $| = 1; print "1..20\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Clone qw( clone );
 $loaded = 1;
@@ -21,11 +21,11 @@
 
 # code to test for memory leaks
 
-use Benchmark;
+## use Benchmark;
 use Data::Dumper;
 # use Storable qw( dclone );
 
-$^W = 0;
+$^W = 1;
 $test = 2;
 
 sub ok     { printf("ok %d\n", $test++); }
@@ -83,3 +83,56 @@
   bless $a, 'Test::Hash';
   bless $b, 'Test::Hash';
 }
+
+# test for cloning ref that was an int(IV)
+{
+  my $a = 1;
+  $a = [];
+  my $b = clone($a);
+  bless $a, 'Test::Hash';
+  bless $b, 'Test::Hash';
+}
+
+# test for cloning ref that was a string(PV)
+{
+  my $a = '';
+  $a = [];
+  my $b = clone($a);
+  bless $a, 'Test::Hash';
+  bless $b, 'Test::Hash';
+}
+
+# test for cloning ref that was a magic(PVMG)
+{
+  my $a = *STDOUT;
+  $a = [];
+  my $b = clone($a);
+  bless $a, 'Test::Hash';
+  bless $b, 'Test::Hash';
+}
+
+# test for cloning weak reference
+{
+  use Scalar::Util qw(weaken isweak);
+  my $a = new Test::Hash();
+  my $b = { r => $a };
+  $a->{r} = $b;
+  weaken($b->{'r'});
+  my $c = clone($a);
+}
+
+# another weak reference problem, this one causes a segfault in 0.24
+{
+  use Scalar::Util qw(weaken isweak);
+  my $a = new Test::Hash();
+  {
+    my $b = [ $a, $a ];
+    $a->{r} = $b;
+    weaken($b->[0]);
+    weaken($b->[1]);
+  }
+  my $c = clone($a);
+  # check that references point to the same thing
+  print  "not " unless $c->{'r'}[0] == $c->{'r'}[1];
+  printf "ok %d\n", $::test++;
+}

Modified: trunk/libclone-perl/t/07magic.t
URL: http://svn.debian.org/wsvn/trunk/libclone-perl/t/07magic.t?rev=15577&op=diff
==============================================================================
--- trunk/libclone-perl/t/07magic.t (original)
+++ trunk/libclone-perl/t/07magic.t Sun Feb 24 23:53:05 2008
@@ -1,4 +1,4 @@
-# $Id: 07magic.t,v 1.7 2006-10-08 05:25:23 ray Exp $
+# $Id: 07magic.t,v 1.8 2007-04-20 05:40:48 ray Exp $
 
 use strict;
 
@@ -19,6 +19,23 @@
     my $z = Clone::clone($x);
     ok( Dumper($x) eq Dumper($z), "Cloned weak reference");
   }
+
+  ## RT 21859: Clone segfault (isolated example)
+  SKIP: {
+    my $string = "HDDR-WD-250JS";
+    eval {
+      use utf8;
+      utf8::upgrade($string);
+    };
+    skip $@, 1 if $@;
+    $string = sprintf ('<<bg_color=%s>>%s<</bg_color>>%s',
+          '#EA0',
+          substr ($string, 0, 4),
+          substr ($string, 4),
+        );
+    my $z = Clone::clone($string);
+    ok( Dumper($string) eq Dumper($z), "Cloned magic utf8");
+  }
 }
 
 SKIP: {
@@ -36,18 +53,3 @@
   ok( Dumper($x) eq Dumper($y), "Tainted input");
 }
 
-## RT 21859: Clone segfault (isolated example)
-SKIP: {
-  eval "use utf8";
-  skip "error in use utf8", 1 if $@;
-  my $string = "HDDR-WD-250JS";
-  utf8::upgrade($string);
-  $string = sprintf ('<<bg_color=%s>>%s<</bg_color>>%s',
-        '#EA0',
-        substr ($string, 0, 4),
-        substr ($string, 4),
-      );
-  print $string, "\n";
-  my $z = Clone::clone($string);
-  ok( 1, "At least it didn't segfault!");
-}




More information about the Pkg-perl-cvs-commits mailing list