File Coverage

Clone.xs

Criterion	Covered	Total	%
statement	68	70	97.1
branch			n/a
condition			n/a
subroutine			n/a
pod			n/a
total	68	70	97.1

line	stmt	code
1		#include <assert.h>
2
3		#include "EXTERN.h"
4		#include "perl.h"
5		#include "XSUB.h"
6
7		static char *rcs_id = "$Id: Clone.xs,v 0.21 2006-10-08 04:02:56 ray Exp $";
8
9		#define CLONE_KEY(x) ((char *) x)
10
11		#define CLONE_STORE(x,y) \
12		do { \
13		if (!hv_store(HSEEN, CLONE_KEY(x), PTRSIZE, SvREFCNT_inc(y), 0)) { \
14		SvREFCNT_dec(y); /* Restore the refcount */ \
15		croak("Can't store clone in seen hash (HSEEN)"); \
16		} \
17		else { \
18		TRACEME(("storing ref = 0x%x clone = 0x%x\n", ref, clone)); \
19		TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone))); \
20		TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref))); \
21		} \
22		} while (0)
23
24		#define CLONE_FETCH(x) (hv_fetch(HSEEN, CLONE_KEY(x), PTRSIZE, 0))
25
26		static SV hv_clone (SV , SV *, int);
27		static SV av_clone (SV , SV *, int);
28		static SV sv_clone (SV , int);
29		static SV rv_clone (SV , int);
30
31		static HV *HSEEN;
32
33		#ifdef DEBUG_CLONE
34		#define TRACEME(a) printf("%s:%d: ",__FUNCTION__, __LINE__) && printf a;
35		#else
36		#define TRACEME(a)
37		#endif
38
39		static SV *
40		hv_clone (SV * ref, SV * target, int depth)
41		{
42	19	HV clone = (HV ) target;
43	19	HV self = (HV ) ref;
44		HE *next = NULL;
45	19	int recur = depth ? depth - 1 : 0;
46
47		assert(SvTYPE(ref) == SVt_PVHV);
48
49		TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref)));
50
51	19	hv_iterinit (self);
52	67	while (next = hv_iternext (self))
53		{
54	29	SV *key = hv_iterkeysv (next);
55	29	hv_store_ent (clone, key,
56		sv_clone (hv_iterval (self, next), recur), 0);
57		}
58
59		TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));
60	19	return (SV *) clone;
61		}
62
63		static SV *
64		av_clone (SV * ref, SV * target, int depth)
65		{
66	10	AV clone = (AV ) target;
67	10	AV self = (AV ) ref;
68		SV **svp;
69		SV *val = NULL;
70		I32 arrlen = 0;
71		int i = 0;
72	10	int recur = depth ? depth - 1 : 0;
73
74		assert(SvTYPE(ref) == SVt_PVAV);
75
76		TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref)));
77
78	10	if (SvREFCNT(ref) > 1)
79	3	CLONE_STORE(ref, (SV *)clone);
80
81	10	arrlen = av_len (self);
82	10	av_extend (clone, arrlen);
83
84	35	for (i = 0; i <= arrlen; i++)
85		{
86	25	svp = av_fetch (self, i, 0);
87	25	if (svp)
88	25	av_store (clone, i, sv_clone (*svp, recur));
89		}
90
91		TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));
92	10	return (SV *) clone;
93		}
94
95		static SV *
96		rv_clone (SV * ref, int depth)
97		{
98		SV *clone = NULL;
99		SV *rv = NULL;
100		UV visible = (SvREFCNT(ref) > 1);
101
102		assert(SvROK(ref));
103
104		TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref)));
105
106		if (!SvROK (ref))
107		return NULL;
108
109		if (sv_isobject (ref))
110		{
111		clone = newRV_noinc(sv_clone (SvRV(ref), depth));
112		sv_2mortal (sv_bless (clone, SvSTASH (SvRV (ref))));
113		}
114		else
115		clone = newRV_inc(sv_clone (SvRV(ref), depth));
116
117		TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));
118		return clone;
119		}
120
121		static SV *
122		sv_clone (SV * ref, int depth)
123	134	{
124		SV *clone = ref;
125		SV **seen = NULL;
126	134	UV visible = (SvREFCNT(ref) > 1);
127		int magic_ref = 0;
128
129		TRACEME(("ref = 0x%x(%d)\n", ref, SvREFCNT(ref)));
130
131	134	if (depth == 0)
132	6	return SvREFCNT_inc(ref);
133
134	128	if (visible && (seen = CLONE_FETCH(ref)))
135		{
136		TRACEME(("fetch ref (0x%x)\n", ref));
137	10	return SvREFCNT_inc(*seen);
138		}
139
140		TRACEME(("switch: (0x%x)\n", ref));
141	118	switch (SvTYPE (ref))
142		{
143		case SVt_NULL: /* 0 */
144		TRACEME(("sv_null\n"));
145	3	clone = newSVsv (ref);
146	3	break;
147		case SVt_IV: /* 1 */
148		TRACEME(("int scalar\n"));
149		case SVt_NV: /* 2 */
150		TRACEME(("double scalar\n"));
151	13	clone = newSVsv (ref);
152	13	break;
153		case SVt_RV: /* 3 */
154		TRACEME(("ref scalar\n"));
155	51	clone = NEWSV(1002, 0);
156	51	sv_upgrade(clone, SVt_RV);
157		/* move the following to SvROK section below */
158		/* SvROK_on(clone); */
159	51	break;
160		case SVt_PV: /* 4 */
161		TRACEME(("string scalar\n"));
162	12	clone = newSVsv (ref);
163	12	break;
164		case SVt_PVIV: /* 5 */
165		TRACEME (("PVIV double-type\n"));
166		case SVt_PVNV: /* 6 */
167		TRACEME (("PVNV double-type\n"));
168	3	clone = newSVsv (ref);
169	3	break;
170		case SVt_PVMG: /* 7 */
171		TRACEME(("magic scalar\n"));
172	5	clone = newSVsv (ref);
173	5	break;
174		case SVt_PVAV: /* 10 */
175	11	clone = (SV *) newAV();
176	11	break;
177		case SVt_PVHV: /* 11 */
178	20	clone = (SV *) newHV();
179	20	break;
180		case SVt_PVBM: /* 8 */
181		case SVt_PVLV: /* 9 */
182		case SVt_PVCV: /* 12 */
183		case SVt_PVGV: /* 13 */
184		case SVt_PVFM: /* 14 */
185		case SVt_PVIO: /* 15 */
186		TRACEME(("default: type = 0x%x\n", SvTYPE (ref)));
187	0	clone = SvREFCNT_inc(ref); /* just return the ref */
188		break;
189		default:
190	0	croak("unkown type: 0x%x", SvTYPE(ref));
191		}
192
193		/**
194		* It is vital that this is performed before recursion,
195		* to properly handle circular references. cb 2001-02-06
196		*/
197
198	118	if ( visible )
199	23	CLONE_STORE(ref,clone);
200
201		/*
202		* We'll assume (in the absence of evidence to the contrary) that A) a
203		* tied hash/array doesn't store its elements in the usual way (i.e.
204		* the mg->mg_object(s) take full responsibility for them) and B) that
205		* references aren't tied.
206		*
207		* If theses assumptions hold, the three options below are mutually
208		* exclusive.
209		*
210		* More precisely: 1 & 2 are probably mutually exclusive; 2 & 3 are
211		* definitely mutually exclusive; we have to test 1 before giving 2
212		* a chance; and we'll assume that 1 & 3 are mutually exclusive unless
213		* and until we can be test-cased out of our delusion.
214		*
215		* chocolateboy: 2001-05-29
216		*/
217
218		/* 1: TIED */
219	118	if (SvMAGICAL(ref) )
220		{
221		MAGIC* mg;
222		MGVTBL *vtable = 0;
223
224	12	for (mg = SvMAGIC(ref); mg; mg = mg->mg_moremagic)
225		{
226		SV obj = (SV ) NULL;
227		/* we don't want to clone a qr (regexp) object */
228		/* there are probably other types as well ... */
229		TRACEME(("magic type: %c\n", mg->mg_type));
230		/* Some mg_obj's can be null, don't bother cloning */
231	6	if ( mg->mg_obj != NULL )
232		{
233	5	switch (mg->mg_type)
234		{
235		case 'r': /* PERL_MAGIC_qr */
236		obj = mg->mg_obj;
237		break;
238		case 't': /* PERL_MAGIC_taint */
239		continue;
240		break;
241		case '<': /* PERL_MAGIC_backref */
242		continue;
243		break;
244		default:
245	3	obj = sv_clone(mg->mg_obj, -1);
246		}
247		} else {
248		TRACEME(("magic object for type %c in NULL\n", mg->mg_type));
249		}
250	5	magic_ref++;
251		/* this is plain old magic, so do the same thing */
252	5	sv_magic(clone,
253		obj,
254		mg->mg_type,
255		mg->mg_ptr,
256		mg->mg_len);
257		}
258		/* major kludge - why does the vtable for a qr type need to be null? */
259	6	if ( mg = mg_find(clone, 'r') )
260	1	mg->mg_virtual = (MGVTBL *) NULL;
261		}
262		/* 2: HASH/ARRAY - (with 'internal' elements) */
263	6	if ( magic_ref )
264		{
265		;;
266		}
267	113	else if ( SvTYPE(ref) == SVt_PVHV )
268		clone = hv_clone (ref, clone, depth);
269	94	else if ( SvTYPE(ref) == SVt_PVAV )
270		clone = av_clone (ref, clone, depth);
271		/* 3: REFERENCE (inlined for speed) */
272	84	else if (SvROK (ref))
273		{
274	51	SvROK_on(clone); /* only set if ROK is set if ref */
275		TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));
276	51	SvRV(clone) = sv_clone (SvRV(ref), depth); /* Clone the referent */
277	51	if (sv_isobject (ref))
278		{
279	15	sv_bless (clone, SvSTASH (SvRV (ref)));
280		}
281		}
282
283		TRACEME(("clone = 0x%x(%d)\n", clone, SvREFCNT(clone)));
284		return clone;
285		}
286
287		MODULE = Clone PACKAGE = Clone
288
289		PROTOTYPES: ENABLE
290
291		BOOT:
292		/* Initialize HSEEN */
293	8	HSEEN = newHV(); if (!HSEEN) croak ("Can't initialize seen hash (HSEEN)");
294
295		void
296		clone(self, depth=-1)
297		SV *self
298		int depth
299		PREINIT:
300		SV * clone = &PL_sv_undef;
301		PPCODE:
302		TRACEME(("ref = 0x%x\n", self));
303	26	clone = sv_clone(self, depth);
304	26	hv_clear(HSEEN); /* Free HV */
305	26	EXTEND(SP,1);
306	26	PUSHs(sv_2mortal(clone));
307