develooper Front page | perl.perl5.porters | Postings from June 2001

[PATCH] New attempt to clone callack

Thread Previous
From:
Artur Bergman
Date:
June 7, 2001 02:52
Subject:
[PATCH] New attempt to clone callack
Message ID:
B7451B6F.12B7%artur@contiller.se
New attempt at CLONE callback patch.

This calls clone for all stashes it finds that has it. If a class wants to
deal with its objects it will need to track them, doing this is rather easy
now with weakrefs. (Scalar::Util::weaken() in the core). I think this
satisfies both ways of cloning speaken about. It allows much more freedom.
IMHO.

I did not change the PL_clone_callbacks yet pending more input.

I can possibly see a bug with UNIVERSAL::CLONE and the "<none>" package,
does even the "<none>" package get UNIVERSAL in it's ISA?

Artur

--- sv.c.old       Wed Jun  6 07:09:11 2001
+++ sv.c        Thu Jun  7 11:42:39 2001
@@ -8335,6 +8335,8 @@
        }
        HvPMROOT((HV*)dstr)     = HvPMROOT((HV*)sstr);          /* XXX */
        HvNAME((HV*)dstr)       = SAVEPV(HvNAME((HV*)sstr));
+    if(HvNAME((HV*)dstr))
+        av_push(PL_clone_callbacks,dstr);
        break;
     case SVt_PVFM:
        SvANY(dstr)     = new_XPVFM();
@@ -8969,6 +8971,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 +9481,24 @@
     if (!(flags & CLONEf_KEEP_PTR_TABLE)) {
         ptr_table_free(PL_ptr_table);
         PL_ptr_table = NULL;
+    }
+    
+    while(av_len(PL_clone_callbacks) != -1) {
+        HV* stash = (HV*) av_shift(PL_clone_callbacks);
+        CV* cloner = (CV*) gv_fetchmethod_autoload(stash,"CLONE",0);
+        if(cloner) {
+            dSP;
+            cloner = GvCV(cloner);
+            ENTER;
+            SAVETMPS;
+            PUSHMARK(SP);
+            XPUSHs(newSVpv(HvNAME(stash),0));
+            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
+


Thread Previous


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About