Miscommunication at #8914: #8902 was okay, #8881 was to be retracted.

[p5sagit/p5-mst-13.2.git] / gv.c

diff --git a/gv.c b/gv.c
index fa830bf..0d34366 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1,6 +1,6 @@
 /*    gv.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -45,8 +45,14 @@ Perl_gv_IOadd(pTHX_ register GV *gv)
 {
     if (!gv || SvTYPE((SV*)gv) != SVt_PVGV)
        Perl_croak(aTHX_ "Bad symbol for filehandle");
-    if (!GvIOp(gv))
+    if (!GvIOp(gv)) {
+#ifdef GV_SHARED_CHECK
+        if (GvSHARED(gv)) {
+            Perl_croak(aTHX_ "Bad symbol for filehandle (GV is shared)");
+        }
+#endif
        GvIOp(gv) = newIO();
+    }
     return gv;
 }
 
@@ -119,7 +125,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
        LEAVE;
 
        PL_sub_generation++;
-       CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv);
+       CvGV(GvCV(gv)) = gv;
        CvFILE(GvCV(gv)) = CopFILE(PL_curcop);
        CvSTASH(GvCV(gv)) = PL_curstash;
 #ifdef USE_THREADS
@@ -412,7 +418,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
        return Nullgv;
     cv = GvCV(gv);
 
-    if (!CvROOT(cv))
+    if (!(CvROOT(cv) || CvXSUB(cv)))
        return Nullgv;
 
     /*
@@ -424,6 +430,20 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
          "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
             HvNAME(stash), (int)len, name);
 
+#ifndef USE_THREADS
+    if (CvXSUB(cv)) {
+        /* rather than lookup/init $AUTOLOAD here
+         * only to have the XSUB do another lookup for $AUTOLOAD
+         * and split that value on the last '::',
+         * pass along the same data via some unused fields in the CV
+         */
+        CvSTASH(cv) = stash;
+        SvPVX(cv) = (char *)name; /* cast to loose constness warning */
+        SvCUR(cv) = len;
+        return gv;
+    }
+#endif
+
     /*
      * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
      * The subroutine's original name may not be "AUTOLOAD", so we don't
@@ -736,20 +756,21 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
            HV *hv;
            I32 i;
            if (!PL_psig_ptr) {
-               int sig_num[] = { SIG_NUM };
-               New(73, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*);
-               New(73, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*);
+               Newz(73, PL_psig_ptr,  SIG_SIZE, SV*);
+               Newz(73, PL_psig_name, SIG_SIZE, SV*);
+               Newz(73, PL_psig_pend, SIG_SIZE, int);
            }
            GvMULTI_on(gv);
            hv = GvHVn(gv);
            hv_magic(hv, Nullgv, 'S');
-           for (i = 1; PL_sig_name[i]; i++) {
+           for (i = 1; i < SIG_SIZE; i++) {
                SV ** init;
                init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1);
                if (init)
                    sv_setsv(*init, &PL_sv_undef);
                PL_psig_ptr[i] = 0;
                PL_psig_name[i] = 0;
+               PL_psig_pend[i] = 0;
            }
        }
        break;
@@ -1141,6 +1162,23 @@ register GV *gv;
 }
 #endif                 /* Microport 2.4 hack */
 
+int
+Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg)
+{
+    AMT *amtp = (AMT*)mg->mg_ptr;
+    if (amtp && AMT_AMAGIC(amtp)) {
+       int i;
+       for (i = 1; i < NofAMmeth; i++) {
+           CV *cv = amtp->table[i];
+           if (cv != Nullcv) {
+               SvREFCNT_dec((SV *) cv);
+               amtp->table[i] = Nullcv;
+           }
+       }
+    }
+ return 0;
+}
+
 /* Updates and caches the CV's */
 
 bool
@@ -1156,18 +1194,11 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
   if (mg && amtp->was_ok_am == PL_amagic_generation
       && amtp->was_ok_sub == PL_sub_generation)
       return AMT_OVERLOADED(amtp);
-  if (amtp && AMT_AMAGIC(amtp)) {      /* Have table. */
-    int i;
-    for (i=1; i<NofAMmeth; i++) {
-      if (amtp->table[i]) {
-       SvREFCNT_dec(amtp->table[i]);
-      }
-    }
-  }
   sv_unmagic((SV*)stash, 'c');
 
   DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME(stash)) );
 
+  Zero(&amt,1,AMT);
   amt.was_ok_am = PL_amagic_generation;
   amt.was_ok_sub = PL_sub_generation;
   amt.fallback = AMGfallNO;
@@ -1176,7 +1207,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
   {
     int filled = 0, have_ovl = 0;
     int i, lim = 1;
-    const char *cp;
     SV* sv = NULL;
 
     /* Work with "fallback" key, which we assume to be first in PL_AMG_names */
@@ -1196,7 +1226,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
     for (i = 1; i < lim; i++)
        amt.table[i] = Nullcv;
     for (; i < NofAMmeth; i++) {
-       char *cooky = PL_AMG_names[i];
+       char *cooky = (char*)PL_AMG_names[i];
        /* Human-readable form, for debugging: */
        char *cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i));
        STRLEN l = strlen(cooky);
@@ -1248,7 +1278,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
     }
   }
   /* Here we have no table: */
- no_table:
+  /* no_table: */
   AMT_AMAGIC_off(&amt);
   sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMTS));
   return FALSE;
@@ -1259,9 +1289,12 @@ CV*
 Perl_gv_handler(pTHX_ HV *stash, I32 id)
 {
     dTHR;
-    MAGIC *mg = mg_find((SV*)stash,'c');
+    MAGIC *mg;
     AMT *amtp;
 
+    if (!stash)
+        return Nullcv;
+    mg = mg_find((SV*)stash,'c');
     if (!mg) {
       do_update:
        Gv_AMupdate(stash);
@@ -1383,6 +1416,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
             lr = 1;
           }
           break;
+        case int_amg:
         case iter_amg:                 /* XXXX Eventually should do to_gv. */
             /* FAIL safe */
             return NULL;       /* Delegate operation to standard mechanisms. */