Use my_tgamma/my_lgamma only ifndef HAS_TGAMMA/HAS_LGAMMA.

[perl5.git] / gv.c

diff --git a/gv.c b/gv.c
index 13f87d6..eaf9d21 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -234,10 +234,10 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
     }
     else if ((hek = CvNAME_HEK(cv))) {
        unshare_hek(hek);
-       CvNAMED_off(cv);
        CvLEXICAL_off(cv);
     }
 
+    CvNAMED_off(cv);
     SvANY(cv)->xcv_gv_u.xcv_gv = gv;
     assert(!CvCVGV_RC(cv));
 
@@ -568,6 +568,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
        GvCVGEN(gv) = 0;
        CvISXSUB_on(cv);
        CvXSUB(cv) = core_xsub;
+       PoisonPADLIST(cv);
     }
     CvGV_set(cv, gv); /* This stops new ATTRSUB from setting CvFILE
                          from PL_curcop. */
@@ -1731,17 +1732,19 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len,
 
     if (!*stash) {
         if (add && !PL_in_clean_all) {
-            SV * const err = Perl_mess(aTHX_
+            GV *gv;
+            qerror(Perl_mess(aTHX_
                  "Global symbol \"%s%"UTF8f
-                 "\" requires explicit package name",
+                 "\" requires explicit package name (did you forget to "
+                 "declare \"my %s%"UTF8f"\"?)",
                  (sv_type == SVt_PV ? "$"
                   : sv_type == SVt_PVAV ? "@"
                   : sv_type == SVt_PVHV ? "%"
-                  : ""), UTF8fARG(is_utf8, len, name));
-            GV *gv;
-            if (is_utf8)
-                SvUTF8_on(err);
-            qerror(err);
+                  : ""), UTF8fARG(is_utf8, len, name),
+                 (sv_type == SVt_PV ? "$"
+                  : sv_type == SVt_PVAV ? "@"
+                  : sv_type == SVt_PVHV ? "%"
+                  : ""), UTF8fARG(is_utf8, len, name)));
             /* To maintain the output of errors after the strict exception
              * above, and to keep compat with older releases, rather than
              * placing the variables in the pad, we place
@@ -1764,6 +1767,12 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len,
     return TRUE;
 }
 
+/* gv_magicalize only turns on the SVf_READONLY flag, not SVf_PROTECT.  So
+   redefine SvREADONLY_on for that purpose.  We don’t use it later on in
+   this file.  */
+#undef SvREADONLY_on
+#define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY)
+
 /* gv_magicalize() is called by gv_fetchpvn_flags when creating
  * a new GV.
  * Note that it does not insert the GV into the stash prior to
@@ -2145,6 +2154,10 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
     return addmg;
 }
 
+/* If we do ever start using this later on in the file, we need to make
+   sure we don’t accidentally use the wrong definition.  */
+#undef SvREADONLY_on
+
 /* This function is called when the stash already holds the GV of the magic
  * variable we're looking for, but we need to check that it has the correct
  * kind of magic.  For example, if someone first uses $! and then %!, the
@@ -2512,6 +2525,16 @@ Perl_gp_free(pTHX_ GV *gv)
            (void)hv_deletehek(PL_stashcache, hvname_hek, G_DISCARD);
        SvREFCNT_dec(hv);
       }
+      if (io && SvREFCNT(io) == 1 && IoIFP(io)
+            && (IoTYPE(io) == IoTYPE_WRONLY ||
+                IoTYPE(io) == IoTYPE_RDWR   ||
+                IoTYPE(io) == IoTYPE_APPEND)
+            && ckWARN_d(WARN_IO)
+            && IoIFP(io) != PerlIO_stdin()
+            && IoIFP(io) != PerlIO_stdout()
+            && IoIFP(io) != PerlIO_stderr()
+            && !(IoFLAGS(io) & IOf_FAKE_DIRP))
+       io_close(io, gv, FALSE, TRUE);
       SvREFCNT_dec(io);
       SvREFCNT_dec(cv);
       SvREFCNT_dec(form);
@@ -2651,11 +2674,14 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
           numifying instead of C's "+0". */
        gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0);
         cv = 0;
-        if (gv && (cv = GvCV(gv)) && CvGV(cv)) {
-           if(GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")){
-             const char * const hvname = HvNAME_get(GvSTASH(CvGV(cv)));
-             if (hvname && HEK_LEN(HvNAME_HEK(GvSTASH(CvGV(cv)))) == 8
-              && strEQ(hvname, "overload")) {
+        if (gv && (cv = GvCV(gv)) && CvHASGV(cv)) {
+            const HEK * const gvhek =
+                CvNAMED(cv) ? CvNAME_HEK(cv) : GvNAME_HEK(CvGV(cv));
+            const HEK * const stashek =
+                HvNAME_HEK(CvNAMED(cv) ? CvSTASH(cv) : GvSTASH(CvGV(cv)));
+            if (HEK_LEN(gvhek) == 3 && strEQ(HEK_KEY(gvhek), "nil")
+             && stashek && HEK_LEN(stashek) == 8
+             && strEQ(HEK_KEY(stashek), "overload")) {
                /* This is a hack to support autoloading..., while
                   knowing *which* methods were declared as overloaded. */
                /* GvSV contains the name of the method. */
@@ -2689,7 +2715,6 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
                    }
                }
                cv = GvCV(gv = ngv);
-             }
            }
            DEBUG_o( Perl_deb(aTHX_ "Overloading \"%s\" in package \"%.256s\" via \"%.256s::%.256s\"\n",
                         cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))),
@@ -3502,7 +3527,7 @@ Perl_gv_try_downgrade(pTHX_ GV *gv)
        (void)hv_deletehek(stash, gvnhek, G_DISCARD);
     } else if (GvMULTI(gv) && cv && SvREFCNT(cv) == 1 &&
            !SvOBJECT(cv) && !SvMAGICAL(cv) && !SvREADONLY(cv) &&
-           CvSTASH(cv) == stash && CvGV(cv) == gv &&
+           CvSTASH(cv) == stash && !CvNAMED(cv) && CvGV(cv) == gv &&
            CvCONST(cv) && !CvMETHOD(cv) && !CvLVALUE(cv) && !CvUNIQUE(cv) &&
            !CvNODEBUG(cv) && !CvCLONE(cv) && !CvCLONED(cv) && !CvANON(cv) &&
            (namehek = GvNAME_HEK(gv)) &&