Use HEKf

This avoids creating a lot of temporary SVs.

diff --git a/doio.c b/doio.c
index b86eac4..06d9bcd 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -126,8 +126,9 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
        if (result == EOF && fd > PL_maxsysfd) {
            /* Why is this not Perl_warn*() call ? */
            PerlIO_printf(Perl_error_log,
-                         "Warning: unable to close filehandle %"SVf" properly.\n",
-                         SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+               "Warning: unable to close filehandle %"HEKf" properly.\n",
+                HEKfARG(GvENAME_HEK(gv))
+           );
        }
        IoOFP(io) = IoIFP(io) = NULL;
     }
@@ -541,14 +542,16 @@ Perl_do_openn(pTHX_ GV *gv, register const char *oname, I32 len, int as_raw,
        if ((IoTYPE(io) == IoTYPE_RDONLY) &&
            (fp == PerlIO_stdout() || fp == PerlIO_stderr())) {
                Perl_warner(aTHX_ packWARN(WARN_IO),
-                           "Filehandle STD%s reopened as %"SVf" only for input",
+                           "Filehandle STD%s reopened as %"HEKf
+                           " only for input",
                            ((fp == PerlIO_stdout()) ? "OUT" : "ERR"),
-                           SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+                           HEKfARG(GvENAME_HEK(gv)));
        }
        else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) {
                Perl_warner(aTHX_ packWARN(WARN_IO),
-                           "Filehandle STDIN reopened as %"SVf" only for output",
-                           SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+                   "Filehandle STDIN reopened as %"HEKf" only for output",
+                    HEKfARG(GvENAME_HEK(gv))
+               );
        }
     }
 
@@ -1337,8 +1340,9 @@ Perl_my_lstat_flags(pTHX_ const U32 flags)
            return PL_laststatval;
        }
        if (ckWARN(WARN_IO)) {
-           Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %"SVf,
-                   SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(cGVOP_gv)))));
+           Perl_warner(aTHX_ packWARN(WARN_IO),
+                            "Use of -l on filehandle %"HEKf,
+                             HEKfARG(GvENAME_HEK(cGVOP_gv)));
        }
        return (PL_laststatval = -1);
     }

diff --git a/gv.c b/gv.c
index edae045..24f4912 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -718,9 +718,9 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
 
         if (!cstash) {
            Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),
-                           "Can't locate package %"SVf" for @%"SVf"::ISA",
+                           "Can't locate package %"SVf" for @%"HEKf"::ISA",
                           SVfARG(linear_sv),
-                           SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))));
+                           HEKfARG(HvNAME_HEK(stash)));
             continue;
         }
 
@@ -1003,8 +1003,10 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
     if (nsplit) {
        if ((nsplit - origname) == 5 && memEQ(origname, "SUPER", 5)) {
            /* ->SUPER::method should really be looked up in original stash */
-           SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"::SUPER",
-                     SVfARG(sv_2mortal(newSVhek(HvNAME_HEK((HV*)CopSTASH(PL_curcop)))))));
+           SV * const tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_
+                    "%"HEKf"::SUPER",
+                     HEKfARG(HvNAME_HEK((HV*)CopSTASH(PL_curcop)))
+           ));
            /* __PACKAGE__::SUPER stash should be autovivified */
            stash = gv_get_super_pkg(SvPVX_const(tmpstr), SvCUR(tmpstr), SvUTF8(tmpstr));
            DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n",
@@ -1051,10 +1053,11 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le
                        return gv;
                }
                Perl_croak(aTHX_
-                          "Can't locate object method \"%"SVf"\" via package \"%"SVf"\"",
+                          "Can't locate object method \"%"SVf
+                          "\" via package \"%"HEKf"\"",
                                    SVfARG(newSVpvn_flags(name, nend - name,
                                            SVs_TEMP | is_utf8)),
-                                    SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))));
+                                    HEKfARG(HvNAME_HEK(stash)));
            }
            else {
                 SV* packnamesv;
@@ -2047,9 +2050,10 @@ Perl_gv_check(pTHX_ const HV *stash)
                    = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0);
 #endif
                Perl_warner(aTHX_ packWARN(WARN_ONCE),
-                       "Name \"%"SVf"::%"SVf"\" used only once: possible typo",
-                            SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))),
-                            SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv)))));
+                       "Name \"%"HEKf"::%"HEKf
+                       "\" used only once: possible typo",
+                            HEKfARG(HvNAME_HEK(stash)),
+                            HEKfARG(GvNAME_HEK(gv)));
            }
        }
     }
@@ -2299,13 +2303,13 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing)
                                                     : newSVpvs_flags("???", SVs_TEMP);
                        Perl_croak(aTHX_ "%s method \"%"SVf256
                                    "\" overloading \"%s\" "\
-                                   "in package \"%"SVf256"\"",
+                                   "in package \"%"HEKf256"\"",
                                   (GvCVGEN(gv) ? "Stub found while resolving"
                                    : "Can't resolve"),
                                   SVfARG(name), cp,
-                                   SVfARG(sv_2mortal(newSVhek(
+                                   HEKfARG(
                                        HvNAME_HEK(stash)
-                                  ))));
+                                  ));
                    }
                }
                cv = GvCV(gv = ngv);

diff --git a/mro.c b/mro.c
index 67c77eb..1d60387 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -224,8 +224,9 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level)
       Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
 
     if (level > 100)
-        Perl_croak(aTHX_ "Recursive inheritance detected in package '%"SVf"'",
-                  SVfARG(sv_2mortal(newSVhek(stashhek))));
+        Perl_croak(aTHX_
+                 "Recursive inheritance detected in package '%"HEKf"'",
+                  HEKfARG(stashhek));
 
     meta = HvMROMETA(stash);
 

diff --git a/pp_sys.c b/pp_sys.c
index 2acacc7..19ba0cb 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -592,8 +592,8 @@ PP(pp_open)
 
        if (IoDIRP(io))
            Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                            "Opening dirhandle %"SVf" also as a file",
-                            SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+                            "Opening dirhandle %"HEKf" also as a file",
+                            HEKfARG(GvENAME_HEK(gv)));
 
        mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
@@ -1389,8 +1389,8 @@ PP(pp_leavewrite)
                SV *topname;
                if (!IoFMT_NAME(io))
                    IoFMT_NAME(io) = savepv(GvNAME(gv));
-               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"_TOP",
-                                        SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv))))));
+               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%"HEKf"_TOP",
+                                        HEKfARG(GvNAME_HEK(gv))));
                topgv = gv_fetchsv(topname, 0, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
                  !gv_fetchpvs("top", GV_NOTQUAL, SVt_PVFM))
@@ -3788,8 +3788,8 @@ PP(pp_open_dir)
 
     if ((IoIFP(io) || IoOFP(io)))
        Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                        "Opening filehandle %"SVf" also as a directory",
-                            SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))) );
+                        "Opening filehandle %"HEKf" also as a directory",
+                            HEKfARG(GvENAME_HEK(gv)) );
     if (IoDIRP(io))
        PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
@@ -3824,8 +3824,8 @@ PP(pp_readdir)
 
     if (!io || !IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "readdir() attempted on invalid dirhandle %"SVf,
-                            SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+                      "readdir() attempted on invalid dirhandle %"HEKf,
+                            HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
 
@@ -3876,8 +3876,8 @@ PP(pp_telldir)
 
     if (!io || !IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "telldir() attempted on invalid dirhandle %"SVf,
-                            SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+                      "telldir() attempted on invalid dirhandle %"HEKf,
+                            HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
 
@@ -3902,8 +3902,8 @@ PP(pp_seekdir)
 
     if (!io || !IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "seekdir() attempted on invalid dirhandle %"SVf,
-                                SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+                      "seekdir() attempted on invalid dirhandle %"HEKf,
+                                HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
     (void)PerlDir_seek(IoDIRP(io), along);
@@ -3927,8 +3927,8 @@ PP(pp_rewinddir)
 
     if (!io || !IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "rewinddir() attempted on invalid dirhandle %"SVf,
-                                SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+                      "rewinddir() attempted on invalid dirhandle %"HEKf,
+                                HEKfARG(GvENAME_HEK(gv)));
        goto nope;
     }
     (void)PerlDir_rewind(IoDIRP(io));
@@ -3951,8 +3951,8 @@ PP(pp_closedir)
 
     if (!io || !IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "closedir() attempted on invalid dirhandle %"SVf,
-                                SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(gv)))));
+                      "closedir() attempted on invalid dirhandle %"HEKf,
+                                HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
 #ifdef VOID_CLOSEDIR

diff --git a/sv.c b/sv.c
index 158410d..3360bf4 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -3846,10 +3846,14 @@ S_glob_assign_ref(pTHX_ SV *const dstr, SV *const sstr)
                            Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
                                        (const char *)
                                        (CvCONST(cv)
-                                        ? "Constant subroutine %"SVf"::%"SVf" redefined"
-                                        : "Subroutine %"SVf"::%"SVf" redefined"),
-               SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(GvSTASH((const GV *)dstr))))),
-               SVfARG(sv_2mortal(newSVhek(GvENAME_HEK(MUTABLE_GV(dstr))))));
+                                        ? "Constant subroutine %"HEKf
+                                          "::%"HEKf" redefined"
+                                        : "Subroutine %"HEKf"::%"HEKf
+                                          " redefined"),
+                               HEKfARG(
+                                HvNAME_HEK(GvSTASH((const GV *)dstr))
+                               ),
+                               HEKfARG(GvENAME_HEK(MUTABLE_GV(dstr))));
                        }
                    }
                if (!intro)
@@ -6352,8 +6356,8 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
        if (check_refcnt && SvREFCNT(sv)) {
            if (PL_in_clean_objs)
                Perl_croak(aTHX_
-                   "DESTROY created new reference to dead object '%"SVf"'",
-                   SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))));
+                 "DESTROY created new reference to dead object '%"HEKf"'",
+                  HEKfARG(HvNAME_HEK(stash)));
            /* DESTROY gave object new lease on life */
            return FALSE;
        }
@@ -8859,8 +8863,8 @@ Perl_sv_2io(pTHX_ SV *const sv)
            gv = MUTABLE_GV(sv);
            io = GvIO(gv);
            if (!io)
-               Perl_croak(aTHX_ "Bad filehandle: %"SVf,
-                                    SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv)))));
+               Perl_croak(aTHX_ "Bad filehandle: %"HEKf,
+                                    HEKfARG(GvNAME_HEK(gv)));
            break;
        }
        /* FALL THROUGH */

diff --git a/universal.c b/universal.c
index a03296d..d623a67 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -307,13 +307,13 @@ Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
        const HV *const stash = GvSTASH(gv);
 
        if (HvNAME_get(stash))
-           Perl_croak(aTHX_ "Usage: %"SVf"::%"SVf"(%s)",
-                                SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))),
-                                SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv)))),
+           Perl_croak(aTHX_ "Usage: %"HEKf"::%"HEKf"(%s)",
+                                HEKfARG(HvNAME_HEK(stash)),
+                                HEKfARG(GvNAME_HEK(gv)),
                                 params);
        else
-           Perl_croak(aTHX_ "Usage: %"SVf"(%s)",
-                                SVfARG(sv_2mortal(newSVhek(GvNAME_HEK(gv)))), params);
+           Perl_croak(aTHX_ "Usage: %"HEKf"(%s)",
+                                HEKfARG(GvNAME_HEK(gv)), params);
     } else {
        /* Pants. I don't think that it should be possible to get here. */
        Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
@@ -437,10 +437,11 @@ XS(XS_UNIVERSAL_VERSION)
 
        if (undef) {
            if (pkg) {
-               const SV * const name = sv_2mortal(newSVhek(HvNAME_HEK(pkg)));
+               const HEK * const name = HvNAME_HEK(pkg);
                Perl_croak(aTHX_
-                          "%"SVf" does not define $%"SVf"::VERSION--version check failed",
-                          SVfARG(name), SVfARG(name));
+                          "%"HEKf" does not define $%"HEKf
+                          "::VERSION--version check failed",
+                          HEKfARG(name), HEKfARG(name));
            } else {
                Perl_croak(aTHX_
                             "%"SVf" defines neither package nor VERSION--version check failed",
@@ -458,15 +459,15 @@ XS(XS_UNIVERSAL_VERSION)
 
        if ( vcmp( req, sv ) > 0 ) {
            if ( hv_exists(MUTABLE_HV(SvRV(req)), "qv", 2 ) ) {
-               Perl_croak(aTHX_ "%"SVf" version %"SVf" required--"
+               Perl_croak(aTHX_ "%"HEKf" version %"SVf" required--"
                       "this is only version %"SVf"",
-                       SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(pkg)))),
+                       HEKfARG(HvNAME_HEK(pkg)),
                       SVfARG(sv_2mortal(vnormal(req))),
                       SVfARG(sv_2mortal(vnormal(sv))));
            } else {
-               Perl_croak(aTHX_ "%"SVf" version %"SVf" required--"
+               Perl_croak(aTHX_ "%"HEKf" version %"SVf" required--"
                       "this is only version %"SVf,
-                       SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(pkg)))),
+                       HEKfARG(HvNAME_HEK(pkg)),
                       SVfARG(sv_2mortal(vstringify(req))),
                       SVfARG(sv_2mortal(vstringify(sv))));
            }