win32 fixes: fix various syntax errors ("no preprocessor directives

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

diff --git a/gv.c b/gv.c
index b038031..1851f8b 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -126,7 +126,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
 
        PL_sub_generation++;
        CvGV(GvCV(gv)) = gv;
-       CvFILE(GvCV(gv)) = CopFILE(PL_curcop);
+       CvFILE_set_from_cop(GvCV(gv), PL_curcop);
        CvSTASH(GvCV(gv)) = PL_curstash;
 #ifdef USE_THREADS
        CvOWNER(GvCV(gv)) = 0;
@@ -195,8 +195,6 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
            return 0;
     }
 
-    if (!HvNAME(stash))
-        Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
     if ((level > 100) || (level < -100))
        Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
              name, HvNAME(stash));
@@ -449,7 +447,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
          * pass along the same data via some unused fields in the CV
          */
         CvSTASH(cv) = stash;
-        SvPVX(cv) = (char *)name; /* cast to loose constness warning */
+        SvPVX(cv) = (char *)name; /* cast to lose constness warning */
         SvCUR(cv) = len;
         return gv;
     }
@@ -897,6 +895,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
     case '\006':       /* $^F */
     case '\010':       /* $^H */
     case '\011':       /* $^I, NOT \t in EBCDIC */
+    case '\016':        /* $^N */
     case '\020':       /* $^P */
     case '\024':       /* $^T */
        if (len > 1)
@@ -1077,7 +1076,7 @@ Perl_gv_check(pTHX_ HV *stash)
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
        for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
            if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
-               (gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)) && HvNAME(hv))
+               (gv = (GV*)HeVAL(entry)) && (hv = GvHV(gv)))
            {
                if (hv != PL_defstash && hv != stash)
                     gv_check(hv);              /* nested package */
@@ -1358,19 +1357,26 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
   CV *cv=NULL;
   CV **cvp=NULL, **ocvp=NULL;
   AMT *amtp=NULL, *oamtp=NULL;
-  int fl=0, off=0, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
+  int off=0, off1, lr=0, assign=AMGf_assign & flags, notfound=0;
   int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0;
-  HV* stash;
+#ifdef DEBUGGING
+  int fl=0;
+#endif
+  HV* stash=NULL;
   if (!(AMGf_noleft & flags) && SvAMAGIC(left)
-      && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),
-                       PERL_MAGIC_overload_table))
+      && (stash = SvSTASH(SvRV(left)))
+      && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table))
       && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
                        ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table
                        : (CV **) NULL))
       && ((cv = cvp[off=method+assignshift])
          || (assign && amtp->fallback > AMGfallNEVER && /* fallback to
                                                          * usual method */
-                 (fl = 1, cv = cvp[off=method])))) {
+                 (
+#ifdef DEBUGGING
+                  fl = 1,
+#endif 
+                  cv = cvp[off=method])))) {
     lr = -1;                   /* Call method for left argument */
   } else {
     if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) {
@@ -1476,8 +1482,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
         }
         if (!cv) goto not_found;
     } else if (!(AMGf_noright & flags) && SvAMAGIC(right)
-              && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),
-                       PERL_MAGIC_overload_table))
+              && (stash = SvSTASH(SvRV(right)))
+              && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table))
               && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr)
                          ? (amtp = (AMT*)mg->mg_ptr)->table
                          : (CV **) NULL))
@@ -1563,21 +1569,23 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
       force_cpy = force_cpy || assign;
     }
   }
+#ifdef DEBUGGING
   if (!notfound) {
-    DEBUG_o( Perl_deb(aTHX_
-  "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
-                AMG_id2name(off),
-                method+assignshift==off? "" :
-                            " (initially `",
-                method+assignshift==off? "" :
-                            AMG_id2name(method+assignshift),
-                method+assignshift==off? "" : "')",
-                flags & AMGf_unary? "" :
-                  lr==1 ? " for right argument": " for left argument",
-                flags & AMGf_unary? " for argument" : "",
-                HvNAME(stash),
-                fl? ",\n\tassignment variant used": "") );
+    DEBUG_o(Perl_deb(aTHX_
+                    "Overloaded operator `%s'%s%s%s:\n\tmethod%s found%s in package %s%s\n",
+                    AMG_id2name(off),
+                    method+assignshift==off? "" :
+                    " (initially `",
+                    method+assignshift==off? "" :
+                    AMG_id2name(method+assignshift),
+                    method+assignshift==off? "" : "')",
+                    flags & AMGf_unary? "" :
+                    lr==1 ? " for right argument": " for left argument",
+                    flags & AMGf_unary? " for argument" : "",
+                    stash ? HvNAME(stash) : "null",
+                    fl? ",\n\tassignment variant used": "") );
   }
+#endif
     /* Since we use shallow copy during assignment, we need
      * to dublicate the contents, probably calling user-supplied
      * version of copy operator
@@ -1766,6 +1774,7 @@ Perl_is_gv_magical(pTHX_ char *name, STRLEN len, U32 flags)
     case '\010':   /* $^H */
     case '\011':   /* $^I, NOT \t in EBCDIC */
     case '\014':   /* $^L */
+    case '\016':   /* $^N */
     case '\020':   /* $^P */
     case '\023':   /* $^S */
     case '\024':   /* $^T */