add patch for printf-style format typechecks (from Robin Barker

<rmb1@cise.npl.co.uk>); fixes for problems so identified

p4raw-id: //depot/perl@4836

diff --git a/XSUB.h b/XSUB.h
index 53ff98d..a1d2257 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
@@ -77,7 +77,7 @@
                                    vn = "VERSION"), FALSE);            \
        }                                                               \
        if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a))))     \
-           Perl_croak(aTHX_ "%s object version %s does not match %s%s%s%s %_", \
+           Perl_croak(aTHX_ "%s object version %s does not match %s%s%s%s %"SVf,\
                  module, XS_VERSION,                                   \
                  vn ? "$" : "", vn ? module : "", vn ? "::" : "",      \
                  vn ? vn : "bootstrap parameter", tmpsv);              \

diff --git a/doio.c b/doio.c
index d2385f0..08264a9 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -217,7 +217,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
        if (*type == '|') {
            if (num_svs && (tlen != 2 || type[1] != '-')) {
              unknown_desr:
-               Perl_croak(aTHX_ "Unknown open() mode '%.*s'", olen, oname);
+               Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname);
            }
            /*SUPPRESS 530*/
            for (type++, tlen--; isSPACE(*type); type++, tlen--) ;

diff --git a/dump.c b/dump.c
index ee64af5..e3648ea 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -78,9 +78,9 @@ Perl_dump_sub(pTHX_ GV *gv)
     gv_fullname3(sv, gv, Nullch);
     Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", SvPVX(sv));
     if (CvXSUB(GvCV(gv)))
-       Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%x %d)\n",
+       Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%lx %d)\n",
            (long)CvXSUB(GvCV(gv)),
-           CvXSUBANY(GvCV(gv)).any_i32);
+           (int)CvXSUBANY(GvCV(gv)).any_i32);
     else if (CvROOT(GvCV(gv)))
        op_dump(CvROOT(GvCV(gv)));
     else
@@ -392,7 +392,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
        if (o->op_type == OP_NULL)
            Perl_dump_indent(aTHX_ level, file, "  (was %s)\n", PL_op_name[o->op_targ]);
        else
-           Perl_dump_indent(aTHX_ level, file, "TARG = %d\n", o->op_targ);
+           Perl_dump_indent(aTHX_ level, file, "TARG = %ld\n", (long)o->op_targ);
     }
 #ifdef DUMPADDR
     Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
@@ -701,7 +701,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne
                do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */
        }
         if (mg->mg_len)
-           Perl_dump_indent(aTHX_ level, file, "    MG_LEN = %d\n", mg->mg_len);
+           Perl_dump_indent(aTHX_ level, file, "    MG_LEN = %ld\n", (long)mg->mg_len);
         if (mg->mg_ptr) {
            Perl_dump_indent(aTHX_ level, file, "    MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr));
            if (mg->mg_len >= 0) {
@@ -782,8 +782,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     Perl_sv_setpvf(aTHX_ d,
                   "(0x%"UVxf") at 0x%"UVxf"\n%*s  REFCNT = %"IVdf"\n%*s  FLAGS = (",
                   PTR2UV(SvANY(sv)), PTR2UV(sv),
-                  PL_dumpindent*level, "", (IV)SvREFCNT(sv),
-                  PL_dumpindent*level, "");
+                  (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv),
+                  (int)(PL_dumpindent*level), "");
 
     if (flags & SVs_PADBUSY)   sv_catpv(d, "PADBUSY,");
     if (flags & SVs_PADTMP)    sv_catpv(d, "PADTMP,");
@@ -1089,7 +1089,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "  MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv)));
        Perl_dump_indent(aTHX_ level, file, "  OWNER = 0x%"UVxf"\n",  PTR2UV(CvOWNER(sv)));
 #endif /* USE_THREADS */
-       Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", CvFLAGS(sv));
+       Perl_dump_indent(aTHX_ level, file, "  FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
        if (type == SVt_PVFM)
            Perl_dump_indent(aTHX_ level, file, "  LINES = %"IVdf"\n", (IV)FmLINES(sv));
        Perl_dump_indent(aTHX_ level, file, "  PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
@@ -1107,7 +1107,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
                                /* %5d below is enough whitespace. */
                                file, 
                                "%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
-                               ix, PTR2UV(ppad[ix]),
+                               (int)ix, PTR2UV(ppad[ix]),
                                SvFAKE(pname[ix]) ? "FAKE " : "",
                                SvPVX(pname[ix]),
                                (IV)SvNVX(pname[ix]),

diff --git a/embed.pl b/embed.pl
index f235ffb..52ab63a 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -134,6 +134,14 @@ sub write_protos {
        }
        $ret .= ")";
        $ret .= " __attribute__((noreturn))" if $flags =~ /r/;
+       if( $flags =~ /f/ ) { 
+           my $prefix = $flags =~ /n/ ? '' : 'pTHX_';
+           my $args = scalar @args; 
+           $ret .= "\n#ifdef CHECK_FORMAT\n";
+           $ret .= sprintf " __attribute__((format(printf,%s%d,%s%d)))",
+                                   $prefix, $args - 1, $prefix, $args; 
+           $ret .= "\n#endif\n";
+       }
        $ret .= ";\n";
     }
     $ret;
@@ -1006,6 +1014,7 @@ __END__
 :                      file
 :      n               has no implicit interpreter/thread context argument
 :      p               function has a Perl_ prefix
+:      f               function takes printf style format string, varargs
 :      r               function never returns
 :       o              has no compatibility macro (#define foo Perl_foo)
 :       j              not a member of CPerlObj
@@ -1124,22 +1133,22 @@ p       |I32    |my_chsize      |int fd|Off_t length
 p      |MAGIC* |condpair_magic |SV *sv
 #endif
 p      |OP*    |convert        |I32 optype|I32 flags|OP* o
-pr     |void   |croak          |const char* pat|...
+fpr    |void   |croak          |const char* pat|...
 pr     |void   |vcroak         |const char* pat|va_list* args
 #if defined(PERL_IMPLICIT_CONTEXT)
-nrp    |void   |croak_nocontext|const char* pat|...
-np     |OP*    |die_nocontext  |const char* pat|...
-np     |void   |deb_nocontext  |const char* pat|...
-np     |char*  |form_nocontext |const char* pat|...
-np     |SV*    |mess_nocontext |const char* pat|...
-np     |void   |warn_nocontext |const char* pat|...
-np     |void   |warner_nocontext|U32 err|const char* pat|...
-np     |SV*    |newSVpvf_nocontext|const char* pat|...
-np     |void   |sv_catpvf_nocontext|SV* sv|const char* pat|...
-np     |void   |sv_setpvf_nocontext|SV* sv|const char* pat|...
-np     |void   |sv_catpvf_mg_nocontext|SV* sv|const char* pat|...
-np     |void   |sv_setpvf_mg_nocontext|SV* sv|const char* pat|...
-np     |int    |fprintf_nocontext|PerlIO* stream|const char* fmt|...
+fnrp   |void   |croak_nocontext|const char* pat|...
+fnp    |OP*    |die_nocontext  |const char* pat|...
+fnp    |void   |deb_nocontext  |const char* pat|...
+fnp    |char*  |form_nocontext |const char* pat|...
+fnp    |SV*    |mess_nocontext |const char* pat|...
+fnp    |void   |warn_nocontext |const char* pat|...
+fnp    |void   |warner_nocontext|U32 err|const char* pat|...
+fnp    |SV*    |newSVpvf_nocontext|const char* pat|...
+fnp    |void   |sv_catpvf_nocontext|SV* sv|const char* pat|...
+fnp    |void   |sv_setpvf_nocontext|SV* sv|const char* pat|...
+fnp    |void   |sv_catpvf_mg_nocontext|SV* sv|const char* pat|...
+fnp    |void   |sv_setpvf_mg_nocontext|SV* sv|const char* pat|...
+fnp    |int    |fprintf_nocontext|PerlIO* stream|const char* fmt|...
 #endif
 p      |void   |cv_ckproto     |CV* cv|GV* gv|char* p
 p      |CV*    |cv_clone       |CV* proto
@@ -1156,7 +1165,7 @@ p |char*  |get_no_modify
 p      |U32*   |get_opargs
 p      |PPADDR_t*|get_ppaddr
 p      |I32    |cxinc
-p      |void   |deb            |const char* pat|...
+fp     |void   |deb            |const char* pat|...
 p      |void   |vdeb           |const char* pat|va_list* args
 p      |void   |debprofdump
 p      |I32    |debop          |OP* o
@@ -1165,7 +1174,7 @@ p |I32    |debstackptrs
 p      |char*  |delimcpy       |char* to|char* toend|char* from \
                                |char* fromend|int delim|I32* retlen
 p      |void   |deprecate      |char* s
-p      |OP*    |die            |const char* pat|...
+fp     |OP*    |die            |const char* pat|...
 p      |OP*    |vdie           |const char* pat|va_list* args
 p      |OP*    |die_where      |char* message|STRLEN msglen
 p      |void   |dounwind       |I32 cxix
@@ -1230,7 +1239,7 @@ p |PADOFFSET|find_threadsv|const char *name
 #endif
 p      |OP*    |force_list     |OP* arg
 p      |OP*    |fold_constants |OP* arg
-p      |char*  |form           |const char* pat|...
+fp     |char*  |form           |const char* pat|...
 p      |char*  |vform          |const char* pat|va_list* args
 p      |void   |free_tmps
 p      |OP*    |gen_constant_list|OP* o
@@ -1405,7 +1414,7 @@ p |void   |markstack_grow
 #if defined(USE_LOCALE_COLLATE)
 p      |char*  |mem_collxfrm   |const char* s|STRLEN len|STRLEN* xlen
 #endif
-p      |SV*    |mess           |const char* pat|...
+fp     |SV*    |mess           |const char* pat|...
 p      |SV*    |vmess          |const char* pat|va_list* args
 p      |void   |qerror         |SV* err
 p      |int    |mg_clear       |SV* sv
@@ -1493,7 +1502,7 @@ p |SV*    |newSViv        |IV i
 p      |SV*    |newSVnv        |NV n
 p      |SV*    |newSVpv        |const char* s|STRLEN len
 p      |SV*    |newSVpvn       |const char* s|STRLEN len
-p      |SV*    |newSVpvf       |const char* pat|...
+fp     |SV*    |newSVpvf       |const char* pat|...
 p      |SV*    |vnewSVpvf      |const char* pat|va_list* args
 p      |SV*    |newSVrv        |SV* rv|const char* classname
 p      |SV*    |newSVsv        |SV* old
@@ -1668,7 +1677,7 @@ p |I32    |sv_true        |SV *sv
 p      |void   |sv_add_arena   |char* ptr|U32 size|U32 flags
 p      |int    |sv_backoff     |SV* sv
 p      |SV*    |sv_bless       |SV* sv|HV* stash
-p      |void   |sv_catpvf      |SV* sv|const char* pat|...
+fp     |void   |sv_catpvf      |SV* sv|const char* pat|...
 p      |void   |sv_vcatpvf     |SV* sv|const char* pat|va_list* args
 p      |void   |sv_catpv       |SV* sv|const char* ptr
 p      |void   |sv_catpvn      |SV* sv|const char* ptr|STRLEN len
@@ -1713,7 +1722,7 @@ p |char*  |sv_reftype     |SV* sv|int ob
 p      |void   |sv_replace     |SV* sv|SV* nsv
 p      |void   |sv_report_used
 p      |void   |sv_reset       |char* s|HV* stash
-p      |void   |sv_setpvf      |SV* sv|const char* pat|...
+fp     |void   |sv_setpvf      |SV* sv|const char* pat|...
 p      |void   |sv_vsetpvf     |SV* sv|const char* pat|va_list* args
 p      |void   |sv_setiv       |SV* sv|IV num
 p      |void   |sv_setpviv     |SV* sv|IV num
@@ -1768,9 +1777,9 @@ p |void   |vivify_ref     |SV* sv|U32 to_what
 p      |I32    |wait4pid       |Pid_t pid|int* statusp|int flags
 p      |void   |report_closed_fh|GV *gv|IO *io|const char *func|const char *obj
 p      |void   |report_uninit
-p      |void   |warn           |const char* pat|...
+fp     |void   |warn           |const char* pat|...
 p      |void   |vwarn          |const char* pat|va_list* args
-p      |void   |warner         |U32 err|const char* pat|...
+fp     |void   |warner         |U32 err|const char* pat|...
 p      |void   |vwarner        |U32 err|const char* pat|va_list* args
 p      |void   |watch          |char** addr
 p      |I32    |whichsig       |char* sig
@@ -1800,12 +1809,12 @@ p       |struct perl_vars *|GetVars
 #endif
 p      |int    |runops_standard
 p      |int    |runops_debug
-p      |void   |sv_catpvf_mg   |SV *sv|const char* pat|...
+fp     |void   |sv_catpvf_mg   |SV *sv|const char* pat|...
 p      |void   |sv_vcatpvf_mg  |SV* sv|const char* pat|va_list* args
 p      |void   |sv_catpv_mg    |SV *sv|const char *ptr
 p      |void   |sv_catpvn_mg   |SV *sv|const char *ptr|STRLEN len
 p      |void   |sv_catsv_mg    |SV *dstr|SV *sstr
-p      |void   |sv_setpvf_mg   |SV *sv|const char* pat|...
+fp     |void   |sv_setpvf_mg   |SV *sv|const char* pat|...
 p      |void   |sv_vsetpvf_mg  |SV* sv|const char* pat|va_list* args
 p      |void   |sv_setiv_mg    |SV *sv|IV i
 p      |void   |sv_setpviv_mg  |SV *sv|IV iv
@@ -1818,7 +1827,7 @@ p |void   |sv_usepvn_mg   |SV *sv|char *ptr|STRLEN len
 p      |MGVTBL*|get_vtbl       |int vtbl_id
 p      |char*  |pv_display     |SV *sv|char *pv|STRLEN cur|STRLEN len \
                                |STRLEN pvlim
-p      |void   |dump_indent    |I32 level|PerlIO *file|const char* pat|...
+fp     |void   |dump_indent    |I32 level|PerlIO *file|const char* pat|...
 p      |void   |dump_vindent   |I32 level|PerlIO *file|const char* pat \
                                |va_list *args
 p      |void   |do_gv_dump     |I32 level|PerlIO *file|char *name|GV *sv

diff --git a/gv.c b/gv.c
index 0305ad5..907620b 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1365,7 +1365,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
        if (amtp && amtp->fallback >= AMGfallYES) {
          DEBUG_o( Perl_deb(aTHX_ "%s", SvPVX(msg)) );
        } else {
-         Perl_croak(aTHX_ "%_", msg);
+         Perl_croak(aTHX_ "%"SVf, msg);
        }
        return NULL;
       }

diff --git a/op.c b/op.c
index 961fe50..823960b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2686,15 +2686,19 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            if (rfirst == 0xffffffff) {
                diff = tdiff;   /* oops, pretend rdiff is infinite */
                if (diff > 0)
-                   Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\tXXXX\n", tfirst, tlast);
+                   Perl_sv_catpvf(aTHX_ listsv, "%04lx\t%04lx\tXXXX\n",
+                                  (long)tfirst, (long)tlast);
                else
-                   Perl_sv_catpvf(aTHX_ listsv, "%04x\t\tXXXX\n", tfirst);
+                   Perl_sv_catpvf(aTHX_ listsv, "%04lx\t\tXXXX\n", (long)tfirst);
            }
            else {
                if (diff > 0)
-                   Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\t%04x\n", tfirst, tfirst + diff, rfirst);
+                   Perl_sv_catpvf(aTHX_ listsv, "%04lx\t%04lx\t%04lx\n",
+                                  (long)tfirst, (long)(tfirst + diff),
+                                  (long)rfirst);
                else
-                   Perl_sv_catpvf(aTHX_ listsv, "%04x\t\t%04x\n", tfirst, rfirst);
+                   Perl_sv_catpvf(aTHX_ listsv, "%04lx\t\t%04lx\n",
+                                  (long)tfirst, (long)rfirst);
 
                if (rfirst + diff > max)
                    max = rfirst + diff;
@@ -4023,7 +4027,7 @@ S_cv_dump(pTHX_ CV *cv)
        if (SvPOK(pname[ix]))
            PerlIO_printf(Perl_debug_log,
                          "\t%4d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n",
-                         ix, PTR2UV(ppad[ix]),
+                         (int)ix, PTR2UV(ppad[ix]),
                          SvFAKE(pname[ix]) ? "FAKE " : "",
                          SvPVX(pname[ix]),
                          (IV)I_32(SvNVX(pname[ix])),
@@ -4190,7 +4194,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
            gv_efullname3(name = sv_newmortal(), gv, Nullch);
        sv_setpv(msg, "Prototype mismatch:");
        if (name)
-           Perl_sv_catpvf(aTHX_ msg, " sub %_", name);
+           Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name);
        if (SvPOK(cv))
            Perl_sv_catpvf(aTHX_ msg, " (%s)", SvPVX(cv));
        sv_catpv(msg, " vs ");
@@ -4198,7 +4202,7 @@ Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
            Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
        else
            sv_catpv(msg, "none");
-       Perl_warner(aTHX_ WARN_UNSAFE, "%_", msg);
+       Perl_warner(aTHX_ WARN_UNSAFE, "%"SVf, msg);
     }
 }
 
@@ -5567,7 +5571,7 @@ Perl_ck_defined(pTHX_ OP *o)              /* 19990527 MJD */
            break;                      /* Globals via GV can be undef */ 
        case OP_PADHV:
            Perl_warner(aTHX_ WARN_DEPRECATED,
-                       "defined(%hash) is deprecated");
+                       "defined(%%hash) is deprecated");
            Perl_warner(aTHX_ WARN_DEPRECATED,
                        "(Maybe you should just omit the defined()?)\n");
            break;

diff --git a/perl.c b/perl.c
index 1b9dac2..4b912e9 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2194,7 +2194,7 @@ sed %s -e \"/^[^#]/b\" \
  -e \"/^#[     ]*undef[        ]/b\" \
  -e \"/^#[     ]*endif/b\" \
  -e \"s/^#.*//\" \
- %s | %_ -C %_ %s",
+ %s | %"SVf" -C %"SVf" %s",
          (PL_doextract ? "-e \"1,/^#/d\n\"" : ""),
 #else
 #  ifdef __OPEN_VM
@@ -2210,7 +2210,7 @@ sed %s -e \"/^[^#]/b\" \
  -e '/^#[      ]*undef[        ]/b' \
  -e '/^#[      ]*endif/b' \
  -e 's/^[      ]*#.*//' \
- %s | %_ %_ %s",
+ %s | %"SVf" %"SVf" %s",
 #  else
        Perl_sv_setpvf(aTHX_ cmd, "\
 %s %s -e '/^[^#]/b' \
@@ -2224,7 +2224,7 @@ sed %s -e \"/^[^#]/b\" \
  -e '/^#[      ]*undef[        ]/b' \
  -e '/^#[      ]*endif/b' \
  -e 's/^[      ]*#.*//' \
- %s | %_ -C %_ %s",
+ %s | %"SVf" -C %"SVf" %s",
 #  endif
 #ifdef LOC_SED
          LOC_SED,
@@ -3054,7 +3054,7 @@ S_incpush(pTHX_ char *p, int addsubdirs)
                              SvPV(libdir,len));
 #endif
            /* .../archname/version if -d .../archname/version/auto */
-           Perl_sv_setpvf(aTHX_ subdir, "%_/%s/"PERL_FS_VER_FMT"/auto", libdir,
+           Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s/"PERL_FS_VER_FMT"/auto", libdir,
                           ARCHNAME, (int)PERL_REVISION,
                           (int)PERL_VERSION, (int)PERL_SUBVERSION);
            if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
@@ -3063,7 +3063,7 @@ S_incpush(pTHX_ char *p, int addsubdirs)
                        newSVpvn(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
 
            /* .../archname if -d .../archname/auto */
-           Perl_sv_setpvf(aTHX_ subdir, "%_/%s/auto", libdir, ARCHNAME);
+           Perl_sv_setpvf(aTHX_ subdir, "%"SVf"/%s/auto", libdir, ARCHNAME);
            if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
                  S_ISDIR(tmpstatbuf.st_mode))
                av_push(GvAVn(PL_incgv),

diff --git a/perl.h b/perl.h
index 30130fd..2da6910 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -189,6 +189,10 @@ struct perl_thread;
 #  define dTHX         dTHXa(PERL_GET_THX)
 #  define pTHX_                pTHX,
 #  define aTHX_                aTHX,
+#  define pTHX_1       2       
+#  define pTHX_2       3
+#  define pTHX_3       4
+#  define pTHX_4       5
 #endif
 
 #define STATIC static
@@ -221,6 +225,10 @@ struct perl_thread;
 #  define aTHX_
 #  define dTHXa(a)     dNOOP
 #  define dTHX         dNOOP
+#  define pTHX_1       1       
+#  define pTHX_2       2
+#  define pTHX_3       3
+#  define pTHX_4       4
 #endif
 
 #ifndef pTHXo
@@ -1674,6 +1682,14 @@ typedef pthread_key_t    perl_key;
 #  endif
 #endif
 
+#ifndef SVf
+#  ifdef CHECK_FORMAT
+#    define SVf "p"
+#  else
+#    define SVf "_"
+#  endif 
+#endif
+
 /* Some unistd.h's give a prototype for pause() even though
    HAS_PAUSE ends up undefined.  This causes the #define
    below to be rejected by the compmiler.  Sigh.

diff --git a/pp_ctl.c b/pp_ctl.c
index 34e18b5..af8b947 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1302,7 +1302,7 @@ Perl_qerror(pTHX_ SV *err)
     else if (PL_errors)
        sv_catsv(PL_errors, err);
     else
-       Perl_warn(aTHX_ "%_", err);
+       Perl_warn(aTHX_ "%"SVf, err);
     ++PL_error_count;
 }
 
@@ -2391,8 +2391,7 @@ PP(pp_goto)
                /* Eventually we may want to stack the needed arguments
                 * for each op.  For now, we punt on the hard ones. */
                if (PL_op->op_type == OP_ENTERITER)
-                   DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop",
-                       label);
+                   DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop");
                CALL_FPTR(PL_op->op_ppaddr)(aTHX);
            }
            PL_op = oldop;
@@ -2869,7 +2868,7 @@ PP(pp_require)
                            && PERL_SUBVERSION < sver))))
            {
                DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version "
-                   "v%"UVuf".%"UVuf".%"UVuf", stopped", rev, ver, sver, PERL_REVISION,
+                   "v%d.%d.%d, stopped", rev, ver, sver, PERL_REVISION,
                    PERL_VERSION, PERL_SUBVERSION);
            }
        }
@@ -2884,7 +2883,7 @@ PP(pp_require)
                + 0.00000099 < SvNV(sv))
            {
                DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version "
-                   "v%"UVuf".%"UVuf".%"UVuf", stopped", rev, ver, sver, PERL_REVISION,
+                   "v%d.%d.%d, stopped", rev, ver, sver, PERL_REVISION,
                    PERL_VERSION, PERL_SUBVERSION);
            }
        }

diff --git a/pp_hot.c b/pp_hot.c
index cd7b6e0..18d717b 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1305,7 +1305,7 @@ Perl_do_readline(pTHX)
                if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) {
                    Perl_warner(aTHX_ WARN_CLOSED,
                           "glob failed (child exited with status %d%s)",
-                          STATUS_CURRENT >> 8,
+                          (int)(STATUS_CURRENT >> 8),
                           (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
                }
            }

diff --git a/pp_sys.c b/pp_sys.c
index 58271c8..ea34bae 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -442,7 +442,7 @@ PP(pp_warn)
     if (!tmps || !len)
        tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26));
 
-    Perl_warn(aTHX_ "%_", tmpsv);
+    Perl_warn(aTHX_ "%"SVf, tmpsv);
     RETSETYES;
 }
 
@@ -500,7 +500,7 @@ PP(pp_die)
     if (!tmps || !len)
        tmpsv = sv_2mortal(newSVpvn("Died", 4));
 
-    DIE(aTHX_ "%_", tmpsv);
+    DIE(aTHX_ "%"SVf, tmpsv);
 }
 
 /* I/O. */

diff --git a/proto.h b/proto.h
index 6f60109..f00531c 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -99,22 +99,78 @@ PERL_CALLCONV I32   Perl_my_chsize(pTHX_ int fd, Off_t length);
 PERL_CALLCONV MAGIC*   Perl_condpair_magic(pTHX_ SV *sv);
 #endif
 PERL_CALLCONV OP*      Perl_convert(pTHX_ I32 optype, I32 flags, OP* o);
-PERL_CALLCONV void     Perl_croak(pTHX_ const char* pat, ...) __attribute__((noreturn));
+PERL_CALLCONV void     Perl_croak(pTHX_ const char* pat, ...) __attribute__((noreturn))
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_1,pTHX_2)))
+#endif
+;
 PERL_CALLCONV void     Perl_vcroak(pTHX_ const char* pat, va_list* args) __attribute__((noreturn));
 #if defined(PERL_IMPLICIT_CONTEXT)
-PERL_CALLCONV void     Perl_croak_nocontext(const char* pat, ...) __attribute__((noreturn));
-PERL_CALLCONV OP*      Perl_die_nocontext(const char* pat, ...);
-PERL_CALLCONV void     Perl_deb_nocontext(const char* pat, ...);
-PERL_CALLCONV char*    Perl_form_nocontext(const char* pat, ...);
-PERL_CALLCONV SV*      Perl_mess_nocontext(const char* pat, ...);
-PERL_CALLCONV void     Perl_warn_nocontext(const char* pat, ...);
-PERL_CALLCONV void     Perl_warner_nocontext(U32 err, const char* pat, ...);
-PERL_CALLCONV SV*      Perl_newSVpvf_nocontext(const char* pat, ...);
-PERL_CALLCONV void     Perl_sv_catpvf_nocontext(SV* sv, const char* pat, ...);
-PERL_CALLCONV void     Perl_sv_setpvf_nocontext(SV* sv, const char* pat, ...);
-PERL_CALLCONV void     Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat, ...);
-PERL_CALLCONV void     Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat, ...);
-PERL_CALLCONV int      Perl_fprintf_nocontext(PerlIO* stream, const char* fmt, ...);
+PERL_CALLCONV void     Perl_croak_nocontext(const char* pat, ...) __attribute__((noreturn))
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,1,2)))
+#endif
+;
+PERL_CALLCONV OP*      Perl_die_nocontext(const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,1,2)))
+#endif
+;
+PERL_CALLCONV void     Perl_deb_nocontext(const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,1,2)))
+#endif
+;
+PERL_CALLCONV char*    Perl_form_nocontext(const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,1,2)))
+#endif
+;
+PERL_CALLCONV SV*      Perl_mess_nocontext(const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,1,2)))
+#endif
+;
+PERL_CALLCONV void     Perl_warn_nocontext(const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,1,2)))
+#endif
+;
+PERL_CALLCONV void     Perl_warner_nocontext(U32 err, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,2,3)))
+#endif
+;
+PERL_CALLCONV SV*      Perl_newSVpvf_nocontext(const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,1,2)))
+#endif
+;
+PERL_CALLCONV void     Perl_sv_catpvf_nocontext(SV* sv, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,2,3)))
+#endif
+;
+PERL_CALLCONV void     Perl_sv_setpvf_nocontext(SV* sv, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,2,3)))
+#endif
+;
+PERL_CALLCONV void     Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,2,3)))
+#endif
+;
+PERL_CALLCONV void     Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,2,3)))
+#endif
+;
+PERL_CALLCONV int      Perl_fprintf_nocontext(PerlIO* stream, const char* fmt, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,2,3)))
+#endif
+;
 #endif
 PERL_CALLCONV void     Perl_cv_ckproto(pTHX_ CV* cv, GV* gv, char* p);
 PERL_CALLCONV CV*      Perl_cv_clone(pTHX_ CV* proto);
@@ -131,7 +187,11 @@ PERL_CALLCONV char*        Perl_get_no_modify(pTHX);
 PERL_CALLCONV U32*     Perl_get_opargs(pTHX);
 PERL_CALLCONV PPADDR_t*        Perl_get_ppaddr(pTHX);
 PERL_CALLCONV I32      Perl_cxinc(pTHX);
-PERL_CALLCONV void     Perl_deb(pTHX_ const char* pat, ...);
+PERL_CALLCONV void     Perl_deb(pTHX_ const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_1,pTHX_2)))
+#endif
+;
 PERL_CALLCONV void     Perl_vdeb(pTHX_ const char* pat, va_list* args);
 PERL_CALLCONV void     Perl_debprofdump(pTHX);
 PERL_CALLCONV I32      Perl_debop(pTHX_ OP* o);
@@ -139,7 +199,11 @@ PERL_CALLCONV I32  Perl_debstack(pTHX);
 PERL_CALLCONV I32      Perl_debstackptrs(pTHX);
 PERL_CALLCONV char*    Perl_delimcpy(pTHX_ char* to, char* toend, char* from, char* fromend, int delim, I32* retlen);
 PERL_CALLCONV void     Perl_deprecate(pTHX_ char* s);
-PERL_CALLCONV OP*      Perl_die(pTHX_ const char* pat, ...);
+PERL_CALLCONV OP*      Perl_die(pTHX_ const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_1,pTHX_2)))
+#endif
+;
 PERL_CALLCONV OP*      Perl_vdie(pTHX_ const char* pat, va_list* args);
 PERL_CALLCONV OP*      Perl_die_where(pTHX_ char* message, STRLEN msglen);
 PERL_CALLCONV void     Perl_dounwind(pTHX_ I32 cxix);
@@ -199,7 +263,11 @@ PERL_CALLCONV PADOFFSET    Perl_find_threadsv(pTHX_ const char *name);
 #endif
 PERL_CALLCONV OP*      Perl_force_list(pTHX_ OP* arg);
 PERL_CALLCONV OP*      Perl_fold_constants(pTHX_ OP* arg);
-PERL_CALLCONV char*    Perl_form(pTHX_ const char* pat, ...);
+PERL_CALLCONV char*    Perl_form(pTHX_ const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_1,pTHX_2)))
+#endif
+;
 PERL_CALLCONV char*    Perl_vform(pTHX_ const char* pat, va_list* args);
 PERL_CALLCONV void     Perl_free_tmps(pTHX);
 PERL_CALLCONV OP*      Perl_gen_constant_list(pTHX_ OP* o);
@@ -369,7 +437,11 @@ PERL_CALLCONV void Perl_markstack_grow(pTHX);
 #if defined(USE_LOCALE_COLLATE)
 PERL_CALLCONV char*    Perl_mem_collxfrm(pTHX_ const char* s, STRLEN len, STRLEN* xlen);
 #endif
-PERL_CALLCONV SV*      Perl_mess(pTHX_ const char* pat, ...);
+PERL_CALLCONV SV*      Perl_mess(pTHX_ const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_1,pTHX_2)))
+#endif
+;
 PERL_CALLCONV SV*      Perl_vmess(pTHX_ const char* pat, va_list* args);
 PERL_CALLCONV void     Perl_qerror(pTHX_ SV* err);
 PERL_CALLCONV int      Perl_mg_clear(pTHX_ SV* sv);
@@ -456,7 +528,11 @@ PERL_CALLCONV SV*  Perl_newSViv(pTHX_ IV i);
 PERL_CALLCONV SV*      Perl_newSVnv(pTHX_ NV n);
 PERL_CALLCONV SV*      Perl_newSVpv(pTHX_ const char* s, STRLEN len);
 PERL_CALLCONV SV*      Perl_newSVpvn(pTHX_ const char* s, STRLEN len);
-PERL_CALLCONV SV*      Perl_newSVpvf(pTHX_ const char* pat, ...);
+PERL_CALLCONV SV*      Perl_newSVpvf(pTHX_ const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_1,pTHX_2)))
+#endif
+;
 PERL_CALLCONV SV*      Perl_vnewSVpvf(pTHX_ const char* pat, va_list* args);
 PERL_CALLCONV SV*      Perl_newSVrv(pTHX_ SV* rv, const char* classname);
 PERL_CALLCONV SV*      Perl_newSVsv(pTHX_ SV* old);
@@ -620,7 +696,11 @@ PERL_CALLCONV I32  Perl_sv_true(pTHX_ SV *sv);
 PERL_CALLCONV void     Perl_sv_add_arena(pTHX_ char* ptr, U32 size, U32 flags);
 PERL_CALLCONV int      Perl_sv_backoff(pTHX_ SV* sv);
 PERL_CALLCONV SV*      Perl_sv_bless(pTHX_ SV* sv, HV* stash);
-PERL_CALLCONV void     Perl_sv_catpvf(pTHX_ SV* sv, const char* pat, ...);
+PERL_CALLCONV void     Perl_sv_catpvf(pTHX_ SV* sv, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_2,pTHX_3)))
+#endif
+;
 PERL_CALLCONV void     Perl_sv_vcatpvf(pTHX_ SV* sv, const char* pat, va_list* args);
 PERL_CALLCONV void     Perl_sv_catpv(pTHX_ SV* sv, const char* ptr);
 PERL_CALLCONV void     Perl_sv_catpvn(pTHX_ SV* sv, const char* ptr, STRLEN len);
@@ -663,7 +743,11 @@ PERL_CALLCONV char*        Perl_sv_reftype(pTHX_ SV* sv, int ob);
 PERL_CALLCONV void     Perl_sv_replace(pTHX_ SV* sv, SV* nsv);
 PERL_CALLCONV void     Perl_sv_report_used(pTHX);
 PERL_CALLCONV void     Perl_sv_reset(pTHX_ char* s, HV* stash);
-PERL_CALLCONV void     Perl_sv_setpvf(pTHX_ SV* sv, const char* pat, ...);
+PERL_CALLCONV void     Perl_sv_setpvf(pTHX_ SV* sv, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_2,pTHX_3)))
+#endif
+;
 PERL_CALLCONV void     Perl_sv_vsetpvf(pTHX_ SV* sv, const char* pat, va_list* args);
 PERL_CALLCONV void     Perl_sv_setiv(pTHX_ SV* sv, IV num);
 PERL_CALLCONV void     Perl_sv_setpviv(pTHX_ SV* sv, IV num);
@@ -712,9 +796,17 @@ PERL_CALLCONV void Perl_vivify_ref(pTHX_ SV* sv, U32 to_what);
 PERL_CALLCONV I32      Perl_wait4pid(pTHX_ Pid_t pid, int* statusp, int flags);
 PERL_CALLCONV void     Perl_report_closed_fh(pTHX_ GV *gv, IO *io, const char *func, const char *obj);
 PERL_CALLCONV void     Perl_report_uninit(pTHX);
-PERL_CALLCONV void     Perl_warn(pTHX_ const char* pat, ...);
+PERL_CALLCONV void     Perl_warn(pTHX_ const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_1,pTHX_2)))
+#endif
+;
 PERL_CALLCONV void     Perl_vwarn(pTHX_ const char* pat, va_list* args);
-PERL_CALLCONV void     Perl_warner(pTHX_ U32 err, const char* pat, ...);
+PERL_CALLCONV void     Perl_warner(pTHX_ U32 err, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_2,pTHX_3)))
+#endif
+;
 PERL_CALLCONV void     Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args);
 PERL_CALLCONV void     Perl_watch(pTHX_ char** addr);
 PERL_CALLCONV I32      Perl_whichsig(pTHX_ char* sig);
@@ -744,12 +836,20 @@ PERL_CALLCONV struct perl_vars *  Perl_GetVars(pTHX);
 #endif
 PERL_CALLCONV int      Perl_runops_standard(pTHX);
 PERL_CALLCONV int      Perl_runops_debug(pTHX);
-PERL_CALLCONV void     Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...);
+PERL_CALLCONV void     Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_2,pTHX_3)))
+#endif
+;
 PERL_CALLCONV void     Perl_sv_vcatpvf_mg(pTHX_ SV* sv, const char* pat, va_list* args);
 PERL_CALLCONV void     Perl_sv_catpv_mg(pTHX_ SV *sv, const char *ptr);
 PERL_CALLCONV void     Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
 PERL_CALLCONV void     Perl_sv_catsv_mg(pTHX_ SV *dstr, SV *sstr);
-PERL_CALLCONV void     Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...);
+PERL_CALLCONV void     Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_2,pTHX_3)))
+#endif
+;
 PERL_CALLCONV void     Perl_sv_vsetpvf_mg(pTHX_ SV* sv, const char* pat, va_list* args);
 PERL_CALLCONV void     Perl_sv_setiv_mg(pTHX_ SV *sv, IV i);
 PERL_CALLCONV void     Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv);
@@ -761,7 +861,11 @@ PERL_CALLCONV void Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr);
 PERL_CALLCONV void     Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
 PERL_CALLCONV MGVTBL*  Perl_get_vtbl(pTHX_ int vtbl_id);
 PERL_CALLCONV char*    Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim);
-PERL_CALLCONV void     Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...);
+PERL_CALLCONV void     Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
+#ifdef CHECK_FORMAT
+ __attribute__((format(printf,pTHX_3,pTHX_4)))
+#endif
+;
 PERL_CALLCONV void     Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args);
 PERL_CALLCONV void     Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv);
 PERL_CALLCONV void     Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv);

diff --git a/regcomp.c b/regcomp.c
index 90500a4..77a4bfc 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -1602,7 +1602,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
            r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
            DEBUG_r((sv = sv_newmortal(),
                     regprop(sv, (regnode*)data.start_class),
-                    PerlIO_printf(Perl_debug_log, "synthetic stclass.\n",
+                    PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n",
                                   SvPVX(sv))));
        }
 
@@ -1651,7 +1651,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm)
            r->reganch &= ~ROPT_SKIP;   /* Used in find_byclass(). */
            DEBUG_r((sv = sv_newmortal(),
                     regprop(sv, (regnode*)data.start_class),
-                    PerlIO_printf(Perl_debug_log, "synthetic stclass.\n",
+                    PerlIO_printf(Perl_debug_log, "synthetic stclass `%s'.\n",
                                   SvPVX(sv))));
        }
     }
@@ -3372,10 +3372,10 @@ S_regclassutf8(pTHX)
                if (!SIZE_ONLY) {
                    if (value == 'p')
                        Perl_sv_catpvf(aTHX_ listsv,
-                                      "+utf8::%.*s\n", n, PL_regcomp_parse);
+                                      "+utf8::%.*s\n", (int)n, PL_regcomp_parse);
                    else
                        Perl_sv_catpvf(aTHX_ listsv,
-                                      "!utf8::%.*s\n", n, PL_regcomp_parse);
+                                      "!utf8::%.*s\n", (int)n, PL_regcomp_parse);
                }
                PL_regcomp_parse = e + 1;
                lastvalue = OOB_UTF8;
@@ -3936,7 +3936,7 @@ Perl_regprop(pTHX_ SV *sv, regnode *o)
     else if (k == WHILEM && o->flags)                  /* Ordinal/of */
        Perl_sv_catpvf(aTHX_ sv, "[%d/%d]", o->flags & 0xf, o->flags>>4);
     else if (k == REF || k == OPEN || k == CLOSE || k == GROUPP )
-       Perl_sv_catpvf(aTHX_ sv, "%d", ARG(o)); /* Parenth number */
+       Perl_sv_catpvf(aTHX_ sv, "%d", (int)ARG(o));    /* Parenth number */
     else if (k == LOGICAL)
        Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags);     /* 2: embedded, otherwise 1 */
     else if (k == ANYOF) {

diff --git a/sv.c b/sv.c
index 010ce2e..2d075b8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5617,7 +5617,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                                       (UV)c & 0xFF);
                } else
                    sv_catpv(msg, "end of string");
-               Perl_warner(aTHX_ WARN_PRINTF, "%_", msg); /* yes, this is reentrant */
+               Perl_warner(aTHX_ WARN_PRINTF, "%"SVf, msg); /* yes, this is reentrant */
            }
 
            /* output mangled stuff ... */

diff --git a/toke.c b/toke.c
index a38f58f..f2e01d6 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1384,7 +1384,7 @@ S_scan_const(pTHX_ char *start)
                            if (ckWARN(WARN_UTF8))
                                Perl_warner(aTHX_ WARN_UTF8,
                                    "\\x%.*s will produce malformed UTF-8 character; use \\x{%.*s} for that",
-                                   len,s,len,s);
+                                   (int)len,s,(int)len,s);
                        }
                        *d++ = (char)uv;
                    }
@@ -7122,7 +7122,7 @@ Perl_yyerror(pTHX_ char *s)
         PL_multi_end = 0;
     }
     if (PL_in_eval & EVAL_WARNONLY)
-       Perl_warn(aTHX_ "%_", msg);
+       Perl_warn(aTHX_ "%"SVf, msg);
     else
        qerror(msg);
     if (PL_error_count >= 10)