Commit 1b69ed268ee99c93f5ea07fd271f288078f4562d - libclone-perl

+19

-0

Changes less more

0	0	Revision history for Perl extension Clone.
1	1
2	2	$Log: Changes,v $
	3	Revision 0.26 2007-10-15 04:52:42 ray
	4	Made a change in CLONE_KEY to the way Clone stores refs in the ref hash.
	5	Perl no longer uses the SvANY part of the SV struct in the same way which
	6	meams the old way of storing the hash key is no longer unique.
	7	Thanks to Slaven Rezic for the patch.
	8
	9	Revision 0.25 2007-07-25 03:41:04 ray
	10	Latest patch from Ruslan Zakirov. Patched another memory leak.
	11
	12	Revision 0.24 2007-07-25 03:33:57 ray
	13	Bug fix for 5.9.*, for some reason the 'visible' logic is no longer working.
	14	I #if 'ed it out until I figure out what is going on.
	15	Also removed an old redundant CLONE_STORE, could have been the cause of some
	16	memory leaks.
	17
	18	Revision 0.23 2007-04-20 05:40:27 ray
	19	Applied patch so clone will contiue to work with newer perls.
	20	Also fixed test to work with older perls.
	21
3	22	Revision 0.22 2006-10-08 05:35:19 ray
4	23	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.
5	24

+2

-2

Clone.pm less more

0		# $Id: Clone.pm,v 0.22 2006-10-08 05:35:19 ray Exp $
	0	# $Id: Clone.pm,v 0.28 2007-10-15 04:52:42 ray Exp $
1	1	package Clone;
2	2
3	3	use strict;

15	15	@EXPORT = qw();
16	16	@EXPORT_OK = qw( clone );
17	17
18		$VERSION = '0.22';
	18	$VERSION = '0.28';
19	19
20	20	bootstrap Clone $VERSION;
21	21

+21

-12

Clone.xs less more

3	3	#include "perl.h"
4	4	#include "XSUB.h"
5	5
6		static char *rcs_id = "$Id: Clone.xs,v 0.21 2006-10-08 04:02:56 ray Exp $";
7
8		#define CLONE_KEY(x) ((char *) x)
	6	static char *rcs_id = "$Id: Clone.xs,v 0.27 2007-10-15 04:52:42 ray Exp $";
	7
	8	#define CLONE_KEY(x) ((char *) &x)
9	9
10	10	#define CLONE_STORE(x,y) \
11	11	do { \

74	74
75	75	TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref)));
76	76
77		if (SvREFCNT(ref) > 1)
78		CLONE_STORE(ref, (SV *)clone);
	77	/* The following is a holdover from a very old version */
	78	/* possible cause of memory leaks */
	79	/* if ( (SvREFCNT(ref) > 1) ) */
	80	/* CLONE_STORE(ref, (SV )clone); /
79	81
80	82	arrlen = av_len (self);
81	83	av_extend (clone, arrlen);

96	98	{
97	99	SV *clone = NULL;
98	100	SV *rv = NULL;
99		UV visible = (SvREFCNT(ref) > 1);
100	101
101	102	assert(SvROK(ref));
102	103

122	123	{
123	124	SV *clone = ref;
124	125	SV **seen = NULL;
125		UV visible = (SvREFCNT(ref) > 1);
	126	#if PERL_REVISION >= 5 && PERL_VERSION > 8
	127	/* This is a hack for perl 5.9., save everything /
	128	/* until I find out why mg_find is no longer working */
	129	UV visible = 1;
	130	#else
	131	UV visible = (SvREFCNT(ref) > 1) \|\| (SvMAGICAL(ref) && mg_find(ref, '<'));
	132	#endif
126	133	int magic_ref = 0;
127	134
128	135	TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref)));

151	158	break;
152	159	case SVt_RV: /* 3 */
153	160	TRACEME(("ref scalar\n"));
154		clone = NEWSV(1002, 0);
155		sv_upgrade(clone, SVt_RV);
156		/* move the following to SvROK section below */
157		/* SvROK_on(clone); */
	161	clone = newSVsv (ref);
158	162	break;
159	163	case SVt_PV: /* 4 */
160	164	TRACEME(("string scalar\n"));

176	180	case SVt_PVHV: /* 11 */
177	181	clone = (SV *) newHV();
178	182	break;
	183	#if PERL_VERSION <= 8
179	184	case SVt_PVBM: /* 8 */
	185	#endif
180	186	case SVt_PVLV: /* 9 */
181	187	case SVt_PVCV: /* 12 */
182	188	case SVt_PVGV: /* 13 */

270	276	/* 3: REFERENCE (inlined for speed) */
271	277	else if (SvROK (ref))
272	278	{
273		SvROK_on(clone); /* only set if ROK is set if ref */
274	279	TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));
	280	SvREFCNT_dec(SvRV(clone));
275	281	SvRV(clone) = sv_clone (SvRV(ref), depth); /* Clone the referent */
276	282	if (sv_isobject (ref))
277	283	{
278	284	sv_bless (clone, SvSTASH (SvRV (ref)));
	285	}
	286	if (SvWEAKREF(ref)) {
	287	sv_rvweaken(clone);
279	288	}
280	289	}
281	290

+1

-1

META.yml less more

0	0	# http://module-build.sourceforge.net/META-spec.html
1	1	#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
2	2	name: Clone
3		version: 0.22
	3	version: 0.28
4	4	version_from: Clone.pm
5	5	installdirs: site
6	6	requires:

+2

-1

Makefile.PL less more

0	0	use ExtUtils::MakeMaker;
1		# $Id: Makefile.PL,v 0.18 2006-10-08 03:37:20 ray Exp $
	1	# $Id: Makefile.PL,v 0.19 2007-10-15 04:57:20 ray Exp $
2	2	# See lib/ExtUtils/MakeMaker.pm for details of how to influence
3	3	# the contents of the Makefile that is written.
4	4	WriteMakefile(

9	9	'INC' => '', # e.g., '-I/usr/include/other'
10	10	# 'OPTIMIZE' => '-g', # e.g., '-I/usr/include/other'
11	11	'OPTIMIZE' => '-O3', # e.g., '-I/usr/include/other'
	12	clean => {FILES => '_Inline'},
12	13	);
13	14

+57

-4

t/06refcnt.t less more

0		# $Id: 06refcnt.t,v 0.18 2006-10-08 03:37:29 ray Exp $
	0	# $Id: 06refcnt.t,v 0.22 2007-07-25 03:41:06 ray Exp $
1	1	# Before `make install' is performed this script should be runnable with
2	2	# `make test'. After `make install' it should work as `perl test.pl'
3	3

6	6	# Change 1..1 below to 1..last_test_to_print .
7	7	# (It may become useful if the test is moved to ./t subdirectory.)
8	8
9		BEGIN { $\| = 1; print "1..9\n"; }
	9	BEGIN { $\| = 1; print "1..20\n"; }
10	10	END {print "not ok 1\n" unless $loaded;}
11	11	use Clone qw( clone );
12	12	$loaded = 1;

20	20
21	21	# code to test for memory leaks
22	22
23		use Benchmark;
	23	## use Benchmark;
24	24	use Data::Dumper;
25	25	# use Storable qw( dclone );
26	26
27		$^W = 0;
	27	$^W = 1;
28	28	$test = 2;
29	29
30	30	sub ok { printf("ok %d\n", $test++); }

82	82	bless $a, 'Test::Hash';
83	83	bless $b, 'Test::Hash';
84	84	}
	85
	86	# test for cloning ref that was an int(IV)
	87	{
	88	my $a = 1;
	89	$a = [];
	90	my $b = clone($a);
	91	bless $a, 'Test::Hash';
	92	bless $b, 'Test::Hash';
	93	}
	94
	95	# test for cloning ref that was a string(PV)
	96	{
	97	my $a = '';
	98	$a = [];
	99	my $b = clone($a);
	100	bless $a, 'Test::Hash';
	101	bless $b, 'Test::Hash';
	102	}
	103
	104	# test for cloning ref that was a magic(PVMG)
	105	{
	106	my $a = *STDOUT;
	107	$a = [];
	108	my $b = clone($a);
	109	bless $a, 'Test::Hash';
	110	bless $b, 'Test::Hash';
	111	}
	112
	113	# test for cloning weak reference
	114	{
	115	use Scalar::Util qw(weaken isweak);
	116	my $a = new Test::Hash();
	117	my $b = { r => $a };
	118	$a->{r} = $b;
	119	weaken($b->{'r'});
	120	my $c = clone($a);
	121	}
	122
	123	# another weak reference problem, this one causes a segfault in 0.24
	124	{
	125	use Scalar::Util qw(weaken isweak);
	126	my $a = new Test::Hash();
	127	{
	128	my $b = [ $a, $a ];
	129	$a->{r} = $b;
	130	weaken($b->[0]);
	131	weaken($b->[1]);
	132	}
	133	my $c = clone($a);
	134	# check that references point to the same thing
	135	print "not " unless $c->{'r'}[0] == $c->{'r'}[1];
	136	printf "ok %d\n", $::test++;
	137	}

+18

-16

t/07magic.t less more

0		# $Id: 07magic.t,v 1.7 2006-10-08 05:25:23 ray Exp $
	0	# $Id: 07magic.t,v 1.8 2007-04-20 05:40:48 ray Exp $
1	1
2	2	use strict;
3	3

18	18	my $z = Clone::clone($x);
19	19	ok( Dumper($x) eq Dumper($z), "Cloned weak reference");
20	20	}
	21
	22	## RT 21859: Clone segfault (isolated example)
	23	SKIP: {
	24	my $string = "HDDR-WD-250JS";
	25	eval {
	26	use utf8;
	27	utf8::upgrade($string);
	28	};
	29	skip $@, 1 if $@;
	30	$string = sprintf ('<<bg_color=%s>>%s<</bg_color>>%s',
	31	'#EA0',
	32	substr ($string, 0, 4),
	33	substr ($string, 4),
	34	);
	35	my $z = Clone::clone($string);
	36	ok( Dumper($string) eq Dumper($z), "Cloned magic utf8");
	37	}
21	38	}
22	39
23	40	SKIP: {

35	52	ok( Dumper($x) eq Dumper($y), "Tainted input");
36	53	}
37	54
38		## RT 21859: Clone segfault (isolated example)
39		SKIP: {
40		eval "use utf8";
41		skip "error in use utf8", 1 if $@;
42		my $string = "HDDR-WD-250JS";
43		utf8::upgrade($string);
44		$string = sprintf ('<<bg_color=%s>>%s<</bg_color>>%s',
45		'#EA0',
46		substr ($string, 0, 4),
47		substr ($string, 4),
48		);
49		print $string, "\n";
50		my $z = Clone::clone($string);
51		ok( 1, "At least it didn't segfault!");
52		}