Propagate 2 edits made in Perl_keywords() back to perl_keywords.pl

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index 5fd385b..56f7df6 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -298,7 +298,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
     SvIOK_off(gv);
     isGV_with_GP_on(gv);
 
-    GvGP(gv) = Perl_newGP(aTHX_ gv);
+    GvGP_set(gv, Perl_newGP(aTHX_ gv));
     GvSTASH(gv) = stash;
     if (stash)
        Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(gv));
@@ -319,7 +319,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
            cv = newCONSTSUB(stash, (name0 ? name0 : name), has_constant);
            /* In case op.c:S_process_special_blocks stole it: */
            if (!GvCV(gv))
-               GvCV(gv) = (CV *)SvREFCNT_inc_simple_NN(cv);
+               GvCV_set(gv, (CV *)SvREFCNT_inc_simple_NN(cv));
            assert(GvCV(gv) == cv); /* newCONSTSUB should have set this */
            if (name0)
                Safefree(name0);
@@ -331,7 +331,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
        } else {
            (void) start_subparse(0,0); /* Create empty CV in compcv. */
            cv = PL_compcv;
-           GvCV(gv) = cv;
+           GvCV_set(gv,cv);
        }
        LEAVE;
 
@@ -456,7 +456,8 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
             else {
                 /* stale cache entry, junk it and move on */
                SvREFCNT_dec(cand_cv);
-               GvCV(topgv) = cand_cv = NULL;
+               GvCV_set(topgv, NULL);
+               cand_cv = NULL;
                GvCVGEN(topgv) = 0;
             }
         }
@@ -506,7 +507,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
             if (topgv && (GvREFCNT(topgv) == 1) && (CvROOT(cand_cv) || CvXSUB(cand_cv))) {
                   if ((old_cv = GvCV(topgv))) SvREFCNT_dec(old_cv);
                   SvREFCNT_inc_simple_void_NN(cand_cv);
-                  GvCV(topgv) = cand_cv;
+                  GvCV_set(topgv, cand_cv);
                   GvCVGEN(topgv) = topgen_cmp;
             }
            return candidate;
@@ -521,7 +522,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
             if (topgv && (GvREFCNT(topgv) == 1) && (CvROOT(cand_cv) || CvXSUB(cand_cv))) {
                   if ((old_cv = GvCV(topgv))) SvREFCNT_dec(old_cv);
                   SvREFCNT_inc_simple_void_NN(cand_cv);
-                  GvCV(topgv) = cand_cv;
+                  GvCV_set(topgv, cand_cv);
                   GvCVGEN(topgv) = topgen_cmp;
             }
             return candidate;
@@ -718,6 +719,20 @@ Perl_gv_fetchmethod_flags(pTHX_ HV *stash, const char *name, U32 flags)
            /* Right now this is exclusively for the benefit of S_method_common
               in pp_hot.c  */
            if (stash) {
+               /* If we can't find an IO::File method, it might be a call on
+                * a filehandle. If IO:File has not been loaded, try to
+                * require it first instead of croaking */
+               const char *stash_name = HvNAME_get(stash);
+               if (stash_name && memEQs(stash_name, HvNAMELEN_get(stash), "IO::File")
+                   && !Perl_hv_common(aTHX_ GvHVn(PL_incgv), NULL,
+                                      STR_WITH_LEN("IO/File.pm"), 0,
+                                      HV_FETCH_ISEXISTS, NULL, 0)
+               ) {
+                   require_pv("IO/File.pm");
+                   gv = gv_fetchmeth(stash, name, nend - name, 0);
+                   if (gv)
+                       return gv;
+               }
                Perl_croak(aTHX_
                           "Can't locate object method \"%s\" via package \"%.*s\"",
                           name, (int)HvNAMELEN_get(stash), HvNAME_get(stash));
@@ -843,7 +858,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
 
 
 /* require_tie_mod() internal routine for requiring a module
- * that implements the logic of automatical ties like %! and %-
+ * that implements the logic of automatic ties like %! and %-
  *
  * The "gv" parameter should be the glob.
  * "varpv" holds the name of the var, used for error messages.
@@ -1691,7 +1706,7 @@ Perl_gp_free(pTHX_ GV *gv)
     if (--gp->gp_refcnt > 0) {
        if (gp->gp_egv == gv)
            gp->gp_egv = 0;
-       GvGP(gv) = 0;
+       GvGP_set(gv, NULL);
         return;
     }
 
@@ -1713,7 +1728,7 @@ Perl_gp_free(pTHX_ GV *gv)
     SvREFCNT_dec(gp->gp_form);
 
     Safefree(gp);
-    GvGP(gv) = 0;
+    GvGP_set(gv, NULL);
 }
 
 int
@@ -1900,7 +1915,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
       do_update:
        /* If we're looking up a destructor to invoke, we must avoid
         * that Gv_AMupdate croaks, because we might be dying already */
-       if (Gv_AMupdate(stash, id == DESTROY_amg) == -1) {
+       if (Gv_AMupdate(stash, cBOOL(id == DESTROY_amg)) == -1) {
            /* and if it didn't found a destructor, we fall back
             * to a simpler method that will only look for the
             * destructor instead of the whole magic */
@@ -2062,6 +2077,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
   int postpr = 0, force_cpy = 0;
   int assign = AMGf_assign & flags;
   const int assignshift = assign ? 1 : 0;
+  int use_default_op = 0;
 #ifdef DEBUGGING
   int fl=0;
 #endif
@@ -2225,9 +2241,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
               && (cv = cvp[off=method])) { /* Method for right
                                             * argument found */
       lr=1;
-    } else if (((ocvp && oamtp->fallback > AMGfallNEVER
-                && (cvp=ocvp) && (lr = -1))
-               || (cvp && amtp->fallback > AMGfallNEVER && (lr=1)))
+    } else if (((cvp && amtp->fallback > AMGfallNEVER)
+                || (ocvp && oamtp->fallback > AMGfallNEVER))
               && !(flags & AMGf_unary)) {
                                /* We look for substitution for
                                 * comparison operations and
@@ -2255,7 +2270,17 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
              off = scmp_amg;
              break;
         }
-      if ((off != -1) && (cv = cvp[off]))
+      if (off != -1) {
+          if (ocvp && (oamtp->fallback > AMGfallNEVER)) {
+              cv = ocvp[off];
+              lr = -1;
+          }
+          if (!cv && (cvp && amtp->fallback > AMGfallNEVER)) {
+              cv = cvp[off];
+              lr = 1;
+          }
+      }
+      if (cv)
           postpr = 1;
       else
           goto not_found;
@@ -2275,7 +2300,10 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
        notfound = 1; lr = -1;
       } else if (cvp && (cv=cvp[nomethod_amg])) {
        notfound = 1; lr = 1;
-      } else if ((amtp && amtp->fallback >= AMGfallYES) && !DEBUG_o_TEST) {
+      } else if ((use_default_op =
+                  (!ocvp || oamtp->fallback >= AMGfallYES)
+                  && (!cvp || amtp->fallback >= AMGfallYES))
+                 && !DEBUG_o_TEST) {
        /* Skip generating the "no method found" message.  */
        return NULL;
       } else {
@@ -2299,7 +2327,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
                      SvAMAGIC(right)?
                        HvNAME_get(SvSTASH(SvRV(right))):
                        ""));
-       if (amtp && amtp->fallback >= AMGfallYES) {
+        if (use_default_op) {
          DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX_const(msg)) );
        } else {
          Perl_croak(aTHX_ "%"SVf, SVfARG(msg));
@@ -2356,7 +2384,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
        * information by hand */
       SV *tmpRef = SvRV(left);
       SV *rv_copy;
-      if (SvREFCNT(tmpRef) > 1 && (rv_copy = AMG_CALLun(left,copy))) {
+      if (SvREFCNT(tmpRef) > 1 && (rv_copy = AMG_CALLunary(left,copy_amg))) {
          SvRV_set(left, rv_copy);
          SvSETMAGIC(left);
          SvREFCNT_dec(tmpRef);  
@@ -2382,7 +2410,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     if (PERLDB_SUB && PL_curstash != PL_debstash)
        PL_op->op_private |= OPpENTERSUB_DB;
     PUTBACK;
-    pp_pushmark();
+    Perl_pp_pushmark(aTHX);
 
     EXTEND(SP, notfound + 5);
     PUSHs(lr>0? right: left);