%_ (was Re: [PATCH] operation on `PL_na' may be undefined)

Message-ID: <20021226211626.GD284@Bagpuss.unfortu.net>

p4raw-id: //depot/perl@18456

diff --git a/doio.c b/doio.c
index 9cfcc4e..e23a2ca 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -775,8 +775,8 @@ Perl_nextargv(pTHX_ register GV *gv)
                    {
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
-                             "Can't do inplace edit: %s would not be unique",
-                             SvPVX(sv));
+                             "Can't do inplace edit: %"SVf" would not be unique",
+                             sv);
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -786,8 +786,8 @@ Perl_nextargv(pTHX_ register GV *gv)
                    if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
-                             "Can't rename %s to %s: %s, skipping file",
-                             PL_oldname, SvPVX(sv), Strerror(errno) );
+                             "Can't rename %s to %"SVf": %s, skipping file",
+                             PL_oldname, sv, Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }
@@ -802,8 +802,8 @@ Perl_nextargv(pTHX_ register GV *gv)
                    if (link(PL_oldname,SvPVX(sv)) < 0) {
                        if (ckWARN_d(WARN_INPLACE))     
                            Perl_warner(aTHX_ packWARN(WARN_INPLACE),
-                             "Can't rename %s to %s: %s, skipping file",
-                             PL_oldname, SvPVX(sv), Strerror(errno) );
+                             "Can't rename %s to %"SVf": %s, skipping file",
+                             PL_oldname, sv, Strerror(errno) );
                        do_close(gv,FALSE);
                        continue;
                    }

diff --git a/dump.c b/dump.c
index 1053f87..6090325 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -73,7 +73,7 @@ Perl_dump_sub(pTHX_ GV *gv)
     SV *sv = sv_newmortal();
 
     gv_fullname3(sv, gv, Nullch);
-    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX(sv));
+    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %"SVf" = ", sv);
     if (CvXSUB(GvCV(gv)))
        Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%"UVxf" %d)\n",
            PTR2UV(CvXSUB(GvCV(gv))),
@@ -90,7 +90,7 @@ Perl_dump_form(pTHX_ GV *gv)
     SV *sv = sv_newmortal();
 
     gv_fullname3(sv, gv, Nullch);
-    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX(sv));
+    Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %"SVf" = ", sv);
     if (CvROOT(GvFORM(gv)))
        op_dump(CvROOT(GvFORM(gv)));
     else
@@ -619,11 +619,10 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
 #else
        if (cSVOPo->op_sv) {
            SV *tmpsv = NEWSV(0,0);
-           STRLEN n_a;
            ENTER;
            SAVEFREESV(tmpsv);
            gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch);
-           Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a));
+           Perl_dump_indent(aTHX_ level, file, "GV = %"SVf"\n", tmpsv);
            LEAVE;
        }
        else
@@ -719,10 +718,10 @@ Perl_gv_dump(pTHX_ GV *gv)
     sv = sv_newmortal();
     PerlIO_printf(Perl_debug_log, "{\n");
     gv_fullname3(sv, gv, Nullch);
-    Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", SvPVX(sv));
+    Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %"SVf"", sv);
     if (gv != GvEGV(gv)) {
        gv_efullname3(sv, GvEGV(gv), Nullch);
-       Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", SvPVX(sv));
+       Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %"SVf"", sv);
     }
     PerlIO_putc(Perl_debug_log, '\n');
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n");
@@ -926,7 +925,6 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     char *s;
     U32 flags;
     U32 type;
-    STRLEN n_a;
 
     if (!sv) {
        Perl_dump_indent(aTHX_ level, file, "SV = 0\n");
@@ -1273,7 +1271,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        break;
     case SVt_PVCV:
        if (SvPOK(sv))
-           Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%s\"\n", SvPV(sv,n_a));
+           Perl_dump_indent(aTHX_ level, file, "  PROTOTYPE = \"%"SVf"\"\n", sv);
        /* FALL THROUGH */
     case SVt_PVFM:
        do_hv_dump(level, file, "  COMP_STASH", CvSTASH(sv));
@@ -1405,7 +1403,6 @@ Perl_debop(pTHX_ OP *o)
     AV *padlist, *comppad;
     CV *cv;
     SV *sv;
-    STRLEN n_a;
 
     if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
        return 0;
@@ -1420,7 +1417,7 @@ Perl_debop(pTHX_ OP *o)
        if (cGVOPo_gv) {
            sv = NEWSV(0,0);
            gv_fullname3(sv, cGVOPo_gv, Nullch);
-           PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a));
+           PerlIO_printf(Perl_debug_log, "(%s)", SvPV_nolen(sv));
            SvREFCNT_dec(sv);
        }
        else

diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index 63b0f79..6c9459e 100644 (file)
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -252,8 +252,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv,
            i = perl_call_method(SvPVX(freezer), G_EVAL|G_SCALAR);
            SPAGAIN;
            if (SvTRUE(ERRSV))
-               warn("WARNING(Freezer method call failed): %s",
-                    SvPVX(ERRSV));
+               warn("WARNING(Freezer method call failed): %"SVf"", ERRSV);
            else if (i)
                val = newSVsv(POPs);
            PUTBACK; FREETMPS; LEAVE;

diff --git a/gv.c b/gv.c
index 68bc3e9..08dd7c3 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -254,8 +254,8 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
            HV* basestash = gv_stashsv(sv, FALSE);
            if (!basestash) {
                if (ckWARN(WARN_MISC))
-                   Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %s for @%s::ISA",
-                       SvPVX(sv), HvNAME(stash));
+                   Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
+                       sv, HvNAME(stash));
                continue;
            }
            gv = gv_fetchmeth(basestash, name, len,
@@ -1328,21 +1328,19 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
                /* GvSV contains the name of the method. */
                GV *ngv = Nullgv;
                
-               DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
-                            SvPV_nolen(GvSV(gv)), cp, HvNAME(stash)) );
+               DEBUG_o( Perl_deb(aTHX_ "Resolving method `%.256"SVf"' for overloaded `%s' in package `%.256s'\n",
+                            GvSV(gv), cp, HvNAME(stash)) );
                if (!SvPOK(GvSV(gv))
                    || !(ngv = gv_fetchmethod_autoload(stash, SvPVX(GvSV(gv)),
                                                       FALSE)))
                {
                    /* Can be an import stub (created by `can'). */
-                   if (GvCVGEN(gv)) {
-                       Perl_croak(aTHX_ "Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'",
-                             (SvPOK(GvSV(gv)) ?  SvPVX(GvSV(gv)) : "???" ),
-                             cp, HvNAME(stash));
-                   } else
-                       Perl_croak(aTHX_ "Can't resolve method `%.256s' overloading `%s' in package `%.256s'",
-                             (SvPOK(GvSV(gv)) ?  SvPVX(GvSV(gv)) : "???" ),
-                             cp, HvNAME(stash));
+                   SV *gvsv = GvSV(gv);
+                   const char *name = SvPOK(gvsv) ?  SvPVX(gvsv) : "???";
+                   Perl_croak(aTHX_ "%s method `%.256s' overloading `%s' in package `%.256s'",
+                              (GvCVGEN(gv) ? "Stub found while resolving"
+                               : "Can't resolve"),
+                              name, cp, HvNAME(stash));
                }
                cv = GvCV(gv = ngv);
            }

diff --git a/op.c b/op.c
index 2368434..f693dfc 100644 (file)
--- a/op.c
+++ b/op.c
@@ -152,8 +152,8 @@ STATIC void
 S_no_bareword_allowed(pTHX_ OP *o)
 {
     qerror(Perl_mess(aTHX_
-                    "Bareword \"%s\" not allowed while \"strict subs\" in use",
-                    SvPV_nolen(cSVOPo_sv)));
+                    "Bareword \"%"SVf"\" not allowed while \"strict subs\" in use",
+                    cSVOPo_sv));
 }
 
 /* "register" allocation */
@@ -3821,7 +3821,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
        if (name)
            Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name);
        if (SvPOK(cv))
-           Perl_sv_catpvf(aTHX_ msg, " (%s)", SvPVX(cv));
+           Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", (SV *)cv);
        sv_catpv(msg, " vs ");
        if (p)
            Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
@@ -4136,7 +4136,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                else {
                    /* force display of errors found but not reported */
                    sv_catpv(ERRSV, not_safe);
-                   Perl_croak(aTHX_ "%s", SvPVx(ERRSV, n_a));
+                   Perl_croak(aTHX_ "%"SVf, ERRSV);
                }
            }
        }
@@ -5991,8 +5991,8 @@ Perl_ck_subr(pTHX_ OP *o)
                continue;
            default:
              oops:
-               Perl_croak(aTHX_ "Malformed prototype for %s: %s",
-                          gv_ename(namegv), SvPV((SV*)cv, n_a));
+               Perl_croak(aTHX_ "Malformed prototype for %s: %"SVf,
+                          gv_ename(namegv), cv);
            }
        }
        else
@@ -6197,8 +6197,8 @@ Perl_peep(pTHX_ register OP *o)
                    SV *sv = sv_newmortal();
                    gv_efullname3(sv, gv, Nullch);
                    Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
-                               "%s() called too early to check prototype",
-                               SvPV_nolen(sv));
+                               "%"SVf"() called too early to check prototype",
+                               sv);
                }
            }
            else if (o->op_next->op_type == OP_READLINE

diff --git a/pad.c b/pad.c
index a36c81f..0eea55c 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -914,7 +914,7 @@ Perl_pad_leavemy(pTHX)
            if ((sv = svp[off]) && sv != &PL_sv_undef
                    && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
                Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                                       "%s never introduced", SvPVX(sv));
+                                       "%"SVf" never introduced", sv);
        }
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
@@ -1173,21 +1173,21 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
        if (namesv) {
            if (SvFAKE(namesv))
                Perl_dump_indent(aTHX_ level+1, file,
-                   "%2d. 0x%"UVxf"<%lu> FAKE \"%s\"\n",
+                   "%2d. 0x%"UVxf"<%lu> FAKE \"%"SVf"\"\n",
                    (int) ix,
                    PTR2UV(ppad[ix]),
                    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
-                   SvPVX(namesv)
+                   namesv
                );
            else
                Perl_dump_indent(aTHX_ level+1, file,
-                   "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n",
+                   "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%"SVf"\"\n",
                    (int) ix,
                    PTR2UV(ppad[ix]),
                    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
                    (unsigned long)I_32(SvNVX(namesv)),
                    (unsigned long)SvIVX(namesv),
-                   SvPVX(namesv)
+                   namesv
                );
        }
        else if (full) {

diff --git a/perl.c b/perl.c
index 2e3de84..8b73d25 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3908,7 +3908,6 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
            atsv = ERRSV;
            (void)SvPV(atsv, len);
            if (len) {
-               STRLEN n_a;
                PL_curcop = &PL_compiling;
                CopLINE_set(PL_curcop, oldline);
                if (paramList == PL_beginav)
@@ -3922,7 +3921,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
                while (PL_scopestack_ix > oldscope)
                    LEAVE;
                JMPENV_POP;
-               Perl_croak(aTHX_ "%s", SvPVx(atsv, n_a));
+               Perl_croak(aTHX_ "%"SVf"", atsv);
            }
            break;
        case 1:

diff --git a/pp_ctl.c b/pp_ctl.c
index bb576d5..5b2eabb 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1820,7 +1820,7 @@ PP(pp_return)
            /* Unassume the success we assumed earlier. */
            SV *nsv = cx->blk_eval.old_namesv;
            (void)hv_delete(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), G_DISCARD);
-           DIE(aTHX_ "%s did not return a true value", SvPVX(nsv));
+           DIE(aTHX_ "%"SVf" did not return a true value", nsv);
        }
        break;
     case CXt_FORMAT:
@@ -2112,7 +2112,7 @@ PP(pp_goto)
                        goto retry;
                    tmpstr = sv_newmortal();
                    gv_efullname3(tmpstr, gv, Nullch);
-                   DIE(aTHX_ "Goto undefined subroutine &%s",SvPVX(tmpstr));
+                   DIE(aTHX_ "Goto undefined subroutine &%"SVf"",tmpstr);
                }
                DIE(aTHX_ "Goto undefined subroutine");
            }
@@ -3367,7 +3367,7 @@ PP(pp_leaveeval)
        /* Unassume the success we assumed earlier. */
        SV *nsv = cx->blk_eval.old_namesv;
        (void)hv_delete(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv), G_DISCARD);
-       retop = Perl_die(aTHX_ "%s did not return a true value", SvPVX(nsv));
+       retop = Perl_die(aTHX_ "%"SVf" did not return a true value", nsv);
        /* die_where() did LEAVE, or we won't be here */
     }
     else {

diff --git a/pp_hot.c b/pp_hot.c
index 5d2388d..24d26d7 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2696,7 +2696,7 @@ try_autoload:
            else {
                sub_name = sv_newmortal();
                gv_efullname3(sub_name, gv, Nullch);
-               DIE(aTHX_ "Undefined subroutine &%s called", SvPVX(sub_name));
+               DIE(aTHX_ "Undefined subroutine &%"SVf" called", sub_name);
            }
        }
        if (!cv)
@@ -2713,8 +2713,8 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
     else {
        SV* tmpstr = sv_newmortal();
        gv_efullname3(tmpstr, CvGV(cv), Nullch);
-       Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%s\"",
-               SvPVX(tmpstr));
+       Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
+               tmpstr);
     }
 }
 
@@ -2730,7 +2730,7 @@ PP(pp_aelem)
     SV *sv;
 
     if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
-       Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%s\" as array index", SvPV_nolen(elemsv));
+       Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%"SVf"\" as array index", elemsv);
     if (elem > 0)
        elem -= PL_curcop->cop_arybase;
     if (SvTYPE(av) != SVt_PVAV)

diff --git a/pp_sort.c b/pp_sort.c
index b109f37..e4b9524 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1455,8 +1455,8 @@ PP(pp_sort)
                else if (gv) {
                    SV *tmpstr = sv_newmortal();
                    gv_efullname3(tmpstr, gv, Nullch);
-                   DIE(aTHX_ "Undefined sort subroutine \"%s\" called",
-                       SvPVX(tmpstr));
+                   DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
+                       tmpstr);
                }
                else {
                    DIE(aTHX_ "Undefined subroutine in sort");

diff --git a/pp_sys.c b/pp_sys.c
index 6de068f..253b860 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -762,7 +762,6 @@ PP(pp_tie)
     char *methname;
     int how = PERL_MAGIC_tied;
     U32 items;
-    STRLEN n_a;
 
     varsv = *++MARK;
     switch(SvTYPE(varsv)) {
@@ -809,8 +808,8 @@ PP(pp_tie)
         */
        stash = gv_stashsv(*MARK, FALSE);
        if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
-           DIE(aTHX_ "Can't locate object method \"%s\" via package \"%s\"",
-                methname, SvPV(*MARK,n_a));
+           DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
+                methname, *MARK);
        }
        ENTER;
        PUSHSTACKi(PERLSI_MAGIC);

diff --git a/sv.c b/sv.c
index 08eac58..ffa71e1 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6911,7 +6911,7 @@ Perl_sv_2io(pTHX_ SV *sv)
        else
            io = 0;
        if (!io)
-           Perl_croak(aTHX_ "Bad filehandle: %s", SvPV(sv,n_a));
+           Perl_croak(aTHX_ "Bad filehandle: %"SVf, sv);
        break;
     }
     return io;
@@ -6992,7 +6992,8 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
                   Nullop);
            LEAVE;
            if (!GvCVu(gv))
-               Perl_croak(aTHX_ "Unable to create sub named \"%s\"", SvPV(sv,n_a));
+               Perl_croak(aTHX_ "Unable to create sub named \"%"SVf"\"",
+                          sv);
        }
        return GvCVu(gv);
     }
@@ -8718,8 +8719,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            if (!args && ckWARN(WARN_PRINTF) &&
                  (PL_op->op_type == OP_PRTF || PL_op->op_type == OP_SPRINTF)) {
                SV *msg = sv_newmortal();
-               Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %s: ",
-                         (PL_op->op_type == OP_PRTF) ? "printf" : "sprintf");
+               Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %sprintf: ",
+                         (PL_op->op_type == OP_PRTF) ? "" : "s");
                if (c) {
                    if (isPRINT(c))
                        Perl_sv_catpvf(aTHX_ msg,

diff --git a/toke.c b/toke.c
index cb8fbea..641e3e3 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5037,8 +5037,8 @@ Perl_yylex(pTHX)
                    d[tmp] = '\0';
                    if (bad_proto && ckWARN(WARN_SYNTAX))
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                                   "Illegal character in prototype for %s : %s",
-                                   SvPVX(PL_subname), d);
+                                   "Illegal character in prototype for %"SVf" : %s",
+                                   PL_subname, d);
                    SvCUR(PL_lex_stuff) = tmp;
                    have_proto = TRUE;
 

diff --git a/universal.c b/universal.c
index 9764ee4..7999757 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -94,8 +94,8 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, HV* name_stash,
                if (!basestash) {
                    if (ckWARN(WARN_MISC))
                        Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
-                            "Can't locate package %s for @%s::ISA",
-                           SvPVX(sv), HvNAME(stash));
+                            "Can't locate package %"SVf" for @%s::ISA",
+                           sv, HvNAME(stash));
                    continue;
                }
                if (&PL_sv_yes == isa_lookup(basestash, name, name_stash, 

diff --git a/utf8.c b/utf8.c
index a5e92cb..19d5ce5 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -1564,8 +1564,8 @@ Perl_swash_init(pTHX_ char* pkg, char* name, SV *listsv, I32 minbits, I32 none)
     }
     if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) {
         if (SvPOK(retval))
-           Perl_croak(aTHX_ "Can't find Unicode property definition \"%s\"",
-                      SvPV_nolen(retval));
+           Perl_croak(aTHX_ "Can't find Unicode property definition \"%"SVf"\"",
+                      retval);
        Perl_croak(aTHX_ "SWASHNEW didn't return an HV ref");
     }
     return retval;