Hi,
This is a patch that calls CLONE on all blessed objects that support it
during a perl_clone.
The reason we need to collect the objects is because the enviroment is not
setup correctly during sv_dup!
If somone would like to point me where to look to extend this support to
call it on classes and not only object I will happily extend it.
All tests pass, if it is accepted I will add tests for it.
Artur
--- sv.c.old Wed Jun 6 07:09:11 2001
+++ sv.c Wed Jun 6 18:10:23 2001
@@ -8384,6 +8384,11 @@
if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO)
++PL_sv_objcount;
+ if (SvOBJECT(dstr)) {
+ av_push(PL_clone_callbacks,dstr);
+ }
+
+
return dstr;
}
@@ -8969,6 +8974,7 @@
while (i-- > 0) {
PL_origargv[i] = SAVEPV(proto_perl->Iorigargv[i]);
}
+ PL_clone_callbacks = newAV(); /* Setup array of objects to callback
on */
PL_envgv = gv_dup(proto_perl->Ienvgv);
PL_incgv = gv_dup(proto_perl->Iincgv);
PL_hintgv = gv_dup(proto_perl->Ihintgv);
@@ -9478,6 +9484,25 @@
if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
ptr_table_free(PL_ptr_table);
PL_ptr_table = NULL;
+ }
+
+ while(av_len(PL_clone_callbacks) != -1) {
+ SV* object = av_shift(PL_clone_callbacks);
+ HV* stash = SvSTASH(object);
+ CV* cloner = gv_fetchmethod(stash,"CLONE");
+ if(cloner) {
+ dSP;
+ cloner = GvCV(cloner);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(newRV_inc(object));
+ PUTBACK;
+ call_sv((SV*)cloner, G_DISCARD);
+ FREETMPS;
+ LEAVE;
+
+ }
}
#ifdef PERL_OBJECT
--- intrpvar.h.old Mon Apr 30 14:19:31 2001
+++ intrpvar.h Wed Jun 6 17:58:44 2001
@@ -478,3 +478,8 @@
/* New variables must be added to the very end for binary compatibility.
* XSUB.h provides wrapper functions via perlapi.h that make this
* irrelevant, but not all code may be expected to #include XSUB.h. */
+
+#if defined(USE_ITHREADS)
+PERLVAR(Iclone_callbacks, AV*) /* used for collecting callbacks during
perl_clone*/
+#endif
+
