From: Marcus Holland-Moritz Date: Mon, 1 Jan 2007 20:16:13 +0000 (+0100) Subject: 4th patch from: X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=be2597dfdde55c276ac6c4b68dadc448c601d0cc;p=p5sagit%2Fp5-mst-13.2.git 4th patch from: Subject: [PATCH] Cleanup SVf arguments (2nd try) Message-ID: <20070101201613.4120d9ef@r2d2> Introduce an SVfARG() macro for %SVf (%-p here) arguments to perl's printf p4raw-id: //depot/perl@29687 --- diff --git a/XSUB.h b/XSUB.h index 47491e8..5817e35 100644 --- a/XSUB.h +++ b/XSUB.h @@ -301,9 +301,9 @@ Rethrows a previously caught exception. See L. _sv = new_version(_sv); \ if ( vcmp(_sv,xssv) ) \ Perl_croak(aTHX_ "%s object version %"SVf" does not match %s%s%s%s %"SVf,\ - module, (void*)vstringify(xssv), \ + module, SVfARG(vstringify(xssv)), \ vn ? "$" : "", vn ? module : "", vn ? "::" : "", \ - vn ? vn : "bootstrap parameter", (void*)vstringify(_sv));\ + vn ? vn : "bootstrap parameter", SVfARG(vstringify(_sv)));\ } \ } STMT_END #else diff --git a/doio.c b/doio.c index a24d572..0208bee 100644 --- a/doio.c +++ b/doio.c @@ -787,7 +787,7 @@ Perl_nextargv(pTHX_ register GV *gv) if (ckWARN_d(WARN_INPLACE)) Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit: %"SVf" would not be unique", - (void*)sv); + SVfARG(sv)); do_close(gv,FALSE); continue; } @@ -798,7 +798,7 @@ Perl_nextargv(pTHX_ register GV *gv) if (ckWARN_d(WARN_INPLACE)) Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't rename %s to %"SVf": %s, skipping file", - PL_oldname, (void*)sv, Strerror(errno)); + PL_oldname, SVfARG(sv), Strerror(errno)); do_close(gv,FALSE); continue; } @@ -815,7 +815,7 @@ Perl_nextargv(pTHX_ register GV *gv) if (ckWARN_d(WARN_INPLACE)) Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't rename %s to %"SVf": %s, skipping file", - PL_oldname, (void*)sv, Strerror(errno) ); + PL_oldname, SVfARG(sv), Strerror(errno) ); do_close(gv,FALSE); continue; } diff --git a/gv.c b/gv.c index b6fa4d0..c7ab061 100644 --- a/gv.c +++ b/gv.c @@ -394,7 +394,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level) if (!basestash) { if (ckWARN(WARN_MISC)) Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA", - (void*)sv, hvname); + SVfARG(sv), hvname); continue; } gv = gv_fetchmeth(basestash, name, len, @@ -1903,7 +1903,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_const(msg)) ); } else { - Perl_croak(aTHX_ "%"SVf, (void*)msg); + Perl_croak(aTHX_ "%"SVf, SVfARG(msg)); } return NULL; } diff --git a/hv.c b/hv.c index bd6a223..07d7f5b 100644 --- a/hv.c +++ b/hv.c @@ -214,7 +214,7 @@ S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, if (flags & HVhek_UTF8) { SvUTF8_on(sv); } - Perl_croak(aTHX_ msg, (void*)sv); + Perl_croak(aTHX_ msg, SVfARG(sv)); } /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot diff --git a/mg.c b/mg.c index 918510f..2bb9b66 100644 --- a/mg.c +++ b/mg.c @@ -2039,7 +2039,7 @@ Perl_vivify_defelem(pTHX_ SV *sv) if (he) value = HeVAL(he); if (!value || value == &PL_sv_undef) - Perl_croak(aTHX_ PL_no_helem_sv, (void*)mg->mg_obj); + Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(mg->mg_obj)); } else { AV* const av = (AV*)LvTARG(sv); diff --git a/op.c b/op.c index b0a0c0f..722867a 100644 --- a/op.c +++ b/op.c @@ -224,7 +224,7 @@ S_no_bareword_allowed(pTHX_ const OP *o) return; /* various ok barewords are hidden in extra OP_NULL */ qerror(Perl_mess(aTHX_ "Bareword \"%"SVf"\" not allowed while \"strict subs\" in use", - (void*)cSVOPo_sv)); + SVfARG(cSVOPo_sv))); } /* "register" allocation */ @@ -4891,9 +4891,9 @@ Perl_cv_ckproto_len(pTHX_ const CV *cv, const GV *gv, const char *p, gv_efullname3(name = sv_newmortal(), gv, NULL); sv_setpv(msg, "Prototype mismatch:"); if (name) - Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, (void*)name); + Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, SVfARG(name)); if (SvPOK(cv)) - Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", (void*)cv); + Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", SVfARG(cv)); else sv_catpvs(msg, ": none"); sv_catpvs(msg, " vs "); @@ -4901,7 +4901,7 @@ Perl_cv_ckproto_len(pTHX_ const CV *cv, const GV *gv, const char *p, Perl_sv_catpvf(aTHX_ msg, "(%.*s)", (int) len, p); else sv_catpvs(msg, "none"); - Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, (void*)msg); + Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, SVfARG(msg)); } } @@ -5312,7 +5312,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_ "%"SVf, (void*)ERRSV); + Perl_croak(aTHX_ "%"SVf, SVfARG(ERRSV)); } } } @@ -5708,7 +5708,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) CopLINE_set(PL_curcop, PL_copline); Perl_warner(aTHX_ packWARN(WARN_REDEFINE), o ? "Format %"SVf" redefined" - : "Format STDOUT redefined", (void*)cSVOPo->op_sv); + : "Format STDOUT redefined", SVfARG(cSVOPo->op_sv)); CopLINE_set(PL_curcop, oldline); } SvREFCNT_dec(cv); @@ -6213,7 +6213,7 @@ Perl_ck_rvconst(pTHX_ register OP *o) if (badthing) Perl_croak(aTHX_ "Can't use bareword (\"%"SVf"\") as %s ref while \"strict refs\" in use", - (void*)kidsv, badthing); + SVfARG(kidsv), badthing); } /* * This is a little tricky. We only want to add the symbol if we @@ -6371,7 +6371,7 @@ Perl_ck_fun(pTHX_ OP *o) if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Array @%"SVf" missing the @ in argument %"IVdf" of %s()", - (void*)((SVOP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]); + SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]); #ifdef PERL_MAD op_getmad(kid,newop,'K'); #else @@ -6394,7 +6394,7 @@ Perl_ck_fun(pTHX_ OP *o) if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX)) Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()", - (void*)((SVOP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]); + SVfARG(((SVOP*)kid)->op_sv), (IV)numargs, PL_op_desc[type]); #ifdef PERL_MAD op_getmad(kid,newop,'K'); #else @@ -7574,7 +7574,7 @@ Perl_ck_subr(pTHX_ OP *o) default: oops: Perl_croak(aTHX_ "Malformed prototype for %s: %"SVf, - gv_ename(namegv), (void*)cv); + gv_ename(namegv), SVfARG(cv)); } } else @@ -7851,7 +7851,7 @@ Perl_peep(pTHX_ register OP *o) gv_efullname3(sv, gv, NULL); Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf"() called too early to check prototype", - (void*)sv); + SVfARG(sv)); } } else if (o->op_next->op_type == OP_READLINE diff --git a/pad.c b/pad.c index c4b8e5e..b1278af 100644 --- a/pad.c +++ b/pad.c @@ -1043,7 +1043,7 @@ Perl_pad_leavemy(pTHX) && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "%"SVf" never introduced", - (void*)sv); + SVfARG(sv)); } } /* "Deintroduce" my variables that are leaving with this scope. */ diff --git a/perl.c b/perl.c index 480619f..973a306 100644 --- a/perl.c +++ b/perl.c @@ -3274,13 +3274,13 @@ Perl_moreswitches(pTHX_ char *s) " DEVEL" STRINGIFY(PERL_PATCHNUM) #endif " built for %s", - (void*)vstringify(PL_patchlevel), + SVfARG(vstringify(PL_patchlevel)), ARCHNAME)); #else /* DGUX */ /* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */ PerlIO_printf(PerlIO_stdout(), Perl_form(aTHX_ "\nThis is perl, %"SVf"\n", - (void*)vstringify(PL_patchlevel))); + SVfARG(vstringify(PL_patchlevel)))); PerlIO_printf(PerlIO_stdout(), Perl_form(aTHX_ " built under %s at %s %s\n", OSNAME, __DATE__, __TIME__)); @@ -3679,8 +3679,8 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv, Perl_sv_setpvf(aTHX_ cmd, "\ %s -ne%s%s%s %s | %"SVf" %s %"SVf" %s", - perl, quote, code, quote, scriptname, (void*)cpp, - cpp_discard_flag, (void*)sv, CPPMINUS); + perl, quote, code, quote, scriptname, SVfARG(cpp), + cpp_discard_flag, SVfARG(sv), CPPMINUS); PL_doextract = FALSE; @@ -5061,21 +5061,21 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, #endif /* .../version/archname if -d .../version/archname */ Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH PERL_ARCH_FMT, - (void*)libdir, + SVfARG(libdir), (int)PERL_REVISION, (int)PERL_VERSION, (int)PERL_SUBVERSION, ARCHNAME); subdir = S_incpush_if_exists(aTHX_ subdir); /* .../version if -d .../version */ Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT_PATH, - (void*)libdir, + SVfARG(libdir), (int)PERL_REVISION, (int)PERL_VERSION, (int)PERL_SUBVERSION); subdir = S_incpush_if_exists(aTHX_ subdir); /* .../archname if -d .../archname */ Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, - (void*)libdir, ARCHNAME); + SVfARG(libdir), ARCHNAME); subdir = S_incpush_if_exists(aTHX_ subdir); } @@ -5084,7 +5084,8 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep, if (addoldvers) { for (incver = incverlist; *incver; incver++) { /* .../xxx if -d .../xxx */ - Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, (void *)libdir, *incver); + Perl_sv_setpvf(aTHX_ subdir, "%"SVf PERL_ARCH_FMT, + SVfARG(libdir), *incver); subdir = S_incpush_if_exists(aTHX_ subdir); } } @@ -5168,7 +5169,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) while (PL_scopestack_ix > oldscope) LEAVE; JMPENV_POP; - Perl_croak(aTHX_ "%"SVf"", (void*)atsv); + Perl_croak(aTHX_ "%"SVf"", SVfARG(atsv)); } break; case 1: diff --git a/perl.h b/perl.h index 16ebc80..4471d79 100644 --- a/perl.h +++ b/perl.h @@ -3047,6 +3047,8 @@ typedef pthread_key_t perl_key; # define SVf256 SVf_(256) #endif +#define SVfARG(p) ((void*)(p)) + #ifndef vdNUMBER # define vdNUMBER 1 #endif diff --git a/perlio.c b/perlio.c index 17e1ee3..ed81598 100644 --- a/perlio.c +++ b/perlio.c @@ -819,7 +819,8 @@ perlio_mg_set(pTHX_ SV *sv, MAGIC *mg) IO * const io = GvIOn((GV *) SvRV(sv)); PerlIO * const ifp = IoIFP(io); PerlIO * const ofp = IoOFP(io); - Perl_warn(aTHX_ "set %" SVf " %p %p %p", (void*)sv, (void*)io, (void*)ifp, (void*)ofp); + Perl_warn(aTHX_ "set %" SVf " %p %p %p", + SVfARG(sv), (void*)io, (void*)ifp, (void*)ofp); } return 0; } @@ -831,7 +832,8 @@ perlio_mg_get(pTHX_ SV *sv, MAGIC *mg) IO * const io = GvIOn((GV *) SvRV(sv)); PerlIO * const ifp = IoIFP(io); PerlIO * const ofp = IoOFP(io); - Perl_warn(aTHX_ "get %" SVf " %p %p %p", (void*)sv, (void*)io, (void*)ifp, (void*)ofp); + Perl_warn(aTHX_ "get %" SVf " %p %p %p", + SVfARG(sv), (void*)io, (void*)ifp, (void*)ofp); } return 0; } @@ -839,14 +841,14 @@ perlio_mg_get(pTHX_ SV *sv, MAGIC *mg) static int perlio_mg_clear(pTHX_ SV *sv, MAGIC *mg) { - Perl_warn(aTHX_ "clear %" SVf, (void*)sv); + Perl_warn(aTHX_ "clear %" SVf, SVfARG(sv)); return 0; } static int perlio_mg_free(pTHX_ SV *sv, MAGIC *mg) { - Perl_warn(aTHX_ "free %" SVf, (void*)sv); + Perl_warn(aTHX_ "free %" SVf, SVfARG(sv)); return 0; } @@ -871,7 +873,7 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES) mg = mg_find(sv, PERL_MAGIC_ext); mg->mg_virtual = &perlio_vtab; mg_magical(sv); - Perl_warn(aTHX_ "attrib %" SVf, (void*)sv); + Perl_warn(aTHX_ "attrib %" SVf, SVfARG(sv)); for (i = 2; i < items; i++) { STRLEN len; const char * const name = SvPV_const(ST(i), len); diff --git a/pp.c b/pp.c index 645ba62..25a7004 100644 --- a/pp.c +++ b/pp.c @@ -4035,7 +4035,7 @@ PP(pp_hslice) if (lval) { if (!svp || *svp == &PL_sv_undef) { - DIE(aTHX_ PL_no_helem_sv, (void*)keysv); + DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv)); } if (localizing) { if (HvNAME_get(hv) && isGV(*svp)) diff --git a/pp_ctl.c b/pp_ctl.c index 28b0484..5c4639f 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1466,7 +1466,7 @@ Perl_qerror(pTHX_ SV *err) else if (PL_errors) sv_catsv(PL_errors, err); else - Perl_warn(aTHX_ "%"SVf, (void*)err); + Perl_warn(aTHX_ "%"SVf, SVfARG(err)); ++PL_error_count; } @@ -2028,7 +2028,7 @@ PP(pp_return) /* Unassume the success we assumed earlier. */ SV * const nsv = cx->blk_eval.old_namesv; (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD); - DIE(aTHX_ "%"SVf" did not return a true value", (void*)nsv); + DIE(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv)); } break; case CXt_FORMAT: @@ -2336,7 +2336,7 @@ PP(pp_goto) goto retry; tmpstr = sv_newmortal(); gv_efullname3(tmpstr, gv, NULL); - DIE(aTHX_ "Goto undefined subroutine &%"SVf"",(void*)tmpstr); + DIE(aTHX_ "Goto undefined subroutine &%"SVf"", SVfARG(tmpstr)); } DIE(aTHX_ "Goto undefined subroutine"); } @@ -3097,12 +3097,12 @@ PP(pp_require) if (cUNOP->op_first->op_type == OP_CONST && cUNOP->op_first->op_private & OPpCONST_NOVER) { if ( vcmp(sv,PL_patchlevel) <= 0 ) DIE(aTHX_ "Perls since %"SVf" too modern--this is %"SVf", stopped", - (void*)vnormal(sv), (void*)vnormal(PL_patchlevel)); + SVfARG(vnormal(sv)), SVfARG(vnormal(PL_patchlevel))); } else { if ( vcmp(sv,PL_patchlevel) > 0 ) DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped", - (void*)vnormal(sv), (void*)vnormal(PL_patchlevel)); + SVfARG(vnormal(sv)), SVfARG(vnormal(PL_patchlevel))); } RETPUSHYES; @@ -3574,7 +3574,7 @@ PP(pp_leaveeval) /* Unassume the success we assumed earlier. */ SV * const nsv = cx->blk_eval.old_namesv; (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD); - retop = Perl_die(aTHX_ "%"SVf" did not return a true value", (void*)nsv); + retop = Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv)); /* die_where() did LEAVE, or we won't be here */ } else { diff --git a/pp_hot.c b/pp_hot.c index bbe3efc..f14faa0 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1838,7 +1838,7 @@ PP(pp_helem) SV* lv; SV* key2; if (!defer) { - DIE(aTHX_ PL_no_helem_sv, (void*)keysv); + DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv)); } lv = sv_newmortal(); sv_upgrade(lv, SVt_PVLV); @@ -2777,7 +2777,7 @@ try_autoload: else { sub_name = sv_newmortal(); gv_efullname3(sub_name, gv, NULL); - DIE(aTHX_ "Undefined subroutine &%"SVf" called", (void*)sub_name); + DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name)); } } if (!cv) @@ -2921,7 +2921,7 @@ Perl_sub_crush_depth(pTHX_ CV *cv) SV* const tmpstr = sv_newmortal(); gv_efullname3(tmpstr, CvGV(cv), NULL); Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"", - (void*)tmpstr); + SVfARG(tmpstr)); } } @@ -2939,7 +2939,7 @@ PP(pp_aelem) if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC)) Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%"SVf"\" as array index", - (void*)elemsv); + SVfARG(elemsv)); if (elem > 0) elem -= CopARYBASE_get(PL_curcop); if (SvTYPE(av) != SVt_PVAV) diff --git a/pp_sort.c b/pp_sort.c index 6899ff4..b9226c2 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -1525,7 +1525,7 @@ PP(pp_sort) SV *tmpstr = sv_newmortal(); gv_efullname3(tmpstr, gv, NULL); DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called", - (void*)tmpstr); + SVfARG(tmpstr)); } else { DIE(aTHX_ "Undefined subroutine in sort"); diff --git a/pp_sys.c b/pp_sys.c index 53bffee..eab721a 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -453,7 +453,7 @@ PP(pp_warn) if (!tmps || !len) tmpsv = sv_2mortal(newSVpvs("Warning: something's wrong")); - Perl_warn(aTHX_ "%"SVf, (void*)tmpsv); + Perl_warn(aTHX_ "%"SVf, SVfARG(tmpsv)); RETSETYES; } @@ -517,7 +517,7 @@ PP(pp_die) if (!tmps || !len) tmpsv = sv_2mortal(newSVpvs("Died")); - DIE(aTHX_ "%"SVf, (void*)tmpsv); + DIE(aTHX_ "%"SVf, SVfARG(tmpsv)); } /* I/O. */ @@ -843,7 +843,7 @@ 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 \"%"SVf"\"", - methname, (void*)*MARK); + methname, SVfARG(*MARK)); } ENTER; PUSHSTACKi(PERLSI_MAGIC); diff --git a/regcomp.c b/regcomp.c index 006855d..93ead7c 100644 --- a/regcomp.c +++ b/regcomp.c @@ -8211,7 +8211,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) AV *list= (AV *)progi->data->data[progi->name_list_idx]; SV **name= av_fetch(list, ARG(o), 0 ); if (name) - Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", (void*)*name); + Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name)); } } else if (k == NREF) { if ( prog->paren_names ) { @@ -8225,7 +8225,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) Perl_sv_catpvf(aTHX_ sv, "%s%"IVdf, (n ? "," : ""), (IV)nums[n]); } - Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", (void*)*name ); + Perl_sv_catpvf(aTHX_ sv, " '%"SVf"'", SVfARG(*name)); } } } else if (k == GOSUB) @@ -8233,7 +8233,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o) else if (k == VERB) { if (!o->flags) Perl_sv_catpvf(aTHX_ sv, ":%"SVf, - (void*)(SV*)progi->data->data[ ARG( o ) ]); + SVfARG((SV*)progi->data->data[ ARG( o ) ])); } else if (k == LOGICAL) Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */ else if (k == ANYOF) { diff --git a/regexec.c b/regexec.c index 9286bba..8c6226f 100644 --- a/regexec.c +++ b/regexec.c @@ -4842,7 +4842,7 @@ NULL PerlIO_printf(Perl_debug_log, "%*s %ssetting cutpoint to mark:%"SVf"...%s\n", REPORT_CODE_OFF+depth*2, "", - PL_colors[4], (void*)sv_commit, PL_colors[5]); + PL_colors[4], SVfARG(sv_commit), PL_colors[5]); }); } mark_state = ST.prev_mark; diff --git a/sv.c b/sv.c index 42071f3..33cdb52 100644 --- a/sv.c +++ b/sv.c @@ -3339,7 +3339,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags) if (SvIS_FREED(dstr)) { Perl_croak(aTHX_ "panic: attempt to copy value %" SVf - " to a freed scalar %p", (void*)sstr, (void*)dstr); + " to a freed scalar %p", SVfARG(sstr), (void *)dstr); } SV_CHECK_THINKFIRST_COW_DROP(dstr); if (!sstr) @@ -5386,7 +5386,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv) PL_utf8cache = 0; Perl_croak(aTHX_ "panic: sv_len_utf8 cache %"UVuf " real %"UVuf" for %"SVf, - (UV) ulen, (UV) real, (void*)sv); + (UV) ulen, (UV) real, SVfARG(sv)); } } } @@ -5544,7 +5544,7 @@ S_sv_pos_u2b_cached(pTHX_ SV *sv, MAGIC **mgp, const U8 *const start, PL_utf8cache = 0; Perl_croak(aTHX_ "panic: sv_pos_u2b_cache cache %"UVuf " real %"UVuf" for %"SVf, - (UV) boffset, (UV) real_boffset, (void*)sv); + (UV) boffset, (UV) real_boffset, SVfARG(sv)); } } boffset = real_boffset; @@ -5666,7 +5666,7 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *sv, MAGIC **mgp, STRLEN byte, STRLEN utf8, SAVEI8(PL_utf8cache); PL_utf8cache = 0; Perl_croak(aTHX_ "panic: utf8_mg_pos_cache_update cache %"UVuf - " real %"UVuf" for %"SVf, (UV) utf8, (UV) realutf8, (void*)sv); + " real %"UVuf" for %"SVf, (UV) utf8, (UV) realutf8, SVfARG(sv)); } } @@ -5889,7 +5889,7 @@ Perl_sv_pos_b2u(pTHX_ register SV* sv, I32* offsetp) PL_utf8cache = 0; Perl_croak(aTHX_ "panic: sv_pos_b2u cache %"UVuf " real %"UVuf" for %"SVf, - (UV) len, (UV) real_len, (void*)sv); + (UV) len, (UV) real_len, SVfARG(sv)); } } len = real_len; @@ -7383,7 +7383,7 @@ Perl_sv_2io(pTHX_ SV *sv) else io = 0; if (!io) - Perl_croak(aTHX_ "Bad filehandle: %"SVf, (void*)sv); + Perl_croak(aTHX_ "Bad filehandle: %"SVf, SVfARG(sv)); break; } return io; @@ -7475,7 +7475,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref) LEAVE; if (!GvCVu(gv)) Perl_croak(aTHX_ "Unable to create sub named \"%"SVf"\"", - (void*)sv); + SVfARG(sv)); } return GvCVu(gv); } @@ -9344,7 +9344,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV (UV)c & 0xFF); } else sv_catpvs(msg, "end of string"); - Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, (void*)msg); /* yes, this is reentrant */ + Perl_warner(aTHX_ packWARN(WARN_PRINTF), "%"SVf, SVfARG(msg)); /* yes, this is reentrant */ } /* output mangled stuff ... */ diff --git a/toke.c b/toke.c index 1dd7bcf..049474d 100644 --- a/toke.c +++ b/toke.c @@ -5679,7 +5679,7 @@ Perl_yylex(pTHX) PUTBACK; PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, Perl_form(aTHX_ ":encoding(%"SVf")", - (void*)name)); + SVfARG(name))); FREETMPS; LEAVE; } @@ -6666,7 +6666,7 @@ Perl_yylex(pTHX) if (bad_proto) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Illegal character in prototype for %"SVf" : %s", - (void*)PL_subname, d); + SVfARG(PL_subname), d); SvCUR_set(PL_lex_stuff, tmp); have_proto = TRUE; @@ -6695,7 +6695,7 @@ Perl_yylex(pTHX) if (!have_name) Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine"); else if (*s != ';') - Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, (void*)PL_subname); + Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, SVfARG(PL_subname)); } #ifdef PERL_MAD @@ -12490,13 +12490,13 @@ Perl_yyerror(pTHX_ const char *s) PL_multi_end = 0; } if (PL_in_eval & EVAL_WARNONLY && ckWARN_d(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, (void*)msg); + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg)); else qerror(msg); if (PL_error_count >= 10) { if (PL_in_eval && SvCUR(ERRSV)) Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n", - (void*)ERRSV, OutCopFILE(PL_curcop)); + SVfARG(ERRSV), OutCopFILE(PL_curcop)); else Perl_croak(aTHX_ "%s has too many errors.\n", OutCopFILE(PL_curcop)); diff --git a/universal.c b/universal.c index 251fbac..aa1bd66 100644 --- a/universal.c +++ b/universal.c @@ -114,7 +114,7 @@ S_isa_lookup(pTHX_ HV *stash, const char *name, const HV* const name_stash, if (ckWARN(WARN_MISC)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA", - (void*)sv, hvname); + SVfARG(sv), hvname); continue; } if (isa_lookup(basestash, name, name_stash, len, level + 1)) { @@ -456,10 +456,10 @@ XS(XS_UNIVERSAL_VERSION) if ( vcmp( req, sv ) > 0 ) Perl_croak(aTHX_ "%s version %"SVf" (%"SVf") required--" "this is only version %"SVf" (%"SVf")", HvNAME_get(pkg), - (void*)vnumify(req), - (void*)vnormal(req), - (void*)vnumify(sv), - (void*)vnormal(sv)); + SVfARG(vnumify(req)), + SVfARG(vnormal(req)), + SVfARG(vnumify(sv)), + SVfARG(vnormal(sv))); } if ( SvOK(sv) && sv_derived_from(sv, "version") ) { @@ -993,11 +993,11 @@ XS(XS_PerlIO_get_layers) else { if (namok && argok) XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")", - (void*)*namsvp, - (void*)*argsvp)); + SVfARG(*namsvp), + SVfARG(*argsvp))); else if (namok) XPUSHs(Perl_newSVpvf(aTHX_ "%"SVf, - (void*)*namsvp)); + SVfARG(*namsvp))); else XPUSHs(&PL_sv_undef); nitem++; diff --git a/utf8.c b/utf8.c index 19f54ca..2575005 100644 --- a/utf8.c +++ b/utf8.c @@ -1620,7 +1620,7 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits if (!SvROK(retval) || SvTYPE(SvRV(retval)) != SVt_PVHV) { if (SvPOK(retval)) Perl_croak(aTHX_ "Can't find Unicode property definition \"%"SVf"\"", - (void*)retval); + SVfARG(retval)); Perl_croak(aTHX_ "SWASHNEW didn't return an HV ref"); } return retval;