X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/6482a30d2bd2742fb2541ea75066fbd5044cc1f8..d34786ba12ee5b96d9e34dd6fcdda158d7d2597b:/pp_ctl.c?ds=sidebyside diff --git a/pp_ctl.c b/pp_ctl.c index 5e44789..f88d401 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -831,7 +831,11 @@ PP(pp_formline) /* Formats aren't yet marked for locales, so assume "yes". */ { STORE_NUMERIC_STANDARD_SET_LOCAL(); +#ifdef USE_SNPRINTF + snprintf(t, SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)), fmt, (int) fieldsize, (int) arg & 255, value); +#else sprintf(t, fmt, (int) fieldsize, (int) arg & 255, value); +#endif /* ifdef USE_SNPRINTF */ RESTORE_NUMERIC_STANDARD(); } t += fieldsize; @@ -1450,7 +1454,7 @@ Perl_qerror(pTHX_ SV *err) else if (PL_errors) sv_catsv(PL_errors, err); else - Perl_warn(aTHX_ "%"SVf, err); + Perl_warn(aTHX_ "%"SVf, (void*)err); ++PL_error_count; } @@ -2012,7 +2016,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", nsv); + DIE(aTHX_ "%"SVf" did not return a true value", (void*)nsv); } break; case CXt_FORMAT: @@ -2320,7 +2324,7 @@ PP(pp_goto) goto retry; tmpstr = sv_newmortal(); gv_efullname3(tmpstr, gv, NULL); - DIE(aTHX_ "Goto undefined subroutine &%"SVf"",tmpstr); + DIE(aTHX_ "Goto undefined subroutine &%"SVf"",(void*)tmpstr); } DIE(aTHX_ "Goto undefined subroutine"); } @@ -2769,8 +2773,13 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp) len = SvCUR(sv); } else +#ifdef USE_SNPRINTF + len = snprintf(tmpbuf, sizeof(tbuf), "_<(%.10s_eval %lu)", code, + (unsigned long)++PL_evalseq); +#else len = my_sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); +#endif /* ifdef USE_SNPRINTF */ SAVECOPFILE_FREE(&PL_compiling); CopFILE_set(&PL_compiling, tmpbuf+2); SAVECOPLINE(&PL_compiling); @@ -3017,10 +3026,11 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq) } STATIC PerlIO * -S_check_type_and_open(pTHX_ const char *name, const char *mode) +S_check_type_and_open(const char *name, const char *mode) { Stat_t st; const int st_rc = PerlLIO_stat(name, &st); + if (st_rc < 0 || S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) { return NULL; } @@ -3087,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", - vnormal(sv), vnormal(PL_patchlevel)); + (void*)vnormal(sv), (void*)vnormal(PL_patchlevel)); } else { if ( vcmp(sv,PL_patchlevel) > 0 ) DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped", - vnormal(sv), vnormal(PL_patchlevel)); + (void*)vnormal(sv), (void*)vnormal(PL_patchlevel)); } RETPUSHYES; @@ -3138,7 +3148,7 @@ PP(pp_require) { namesv = newSV(0); for (i = 0; i <= AvFILL(ar); i++) { - SV *dirsv = *av_fetch(ar, i, TRUE); + SV * const dirsv = *av_fetch(ar, i, TRUE); if (SvROK(dirsv)) { int count; @@ -3191,7 +3201,7 @@ PP(pp_require) } if (SvTYPE(arg) == SVt_PVGV) { - IO *io = GvIO((GV *)arg); + IO * const io = GvIO((GV *)arg); ++filter_has_file; @@ -3422,6 +3432,10 @@ PP(pp_entereval) CV* runcv; U32 seq; HV *saved_hh = NULL; + const char * const fakestr = "_<(eval )"; +#ifdef HAS_STRLCPY + const int fakelen = 9 + 1; +#endif if (PL_op->op_private & OPpEVAL_HAS_HH) { saved_hh = (HV*) SvREFCNT_inc(POPs); @@ -3447,7 +3461,11 @@ PP(pp_entereval) len = SvCUR(temp_sv); } else +#ifdef USE_SNPRINTF + len = snprintf(tmpbuf, sizeof(tbuf), "_<(eval %lu)", (unsigned long)++PL_evalseq); +#else len = my_sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq); +#endif /* ifdef USE_SNPRINTF */ SAVECOPFILE_FREE(&PL_compiling); CopFILE_set(&PL_compiling, tmpbuf+2); SAVECOPLINE(&PL_compiling); @@ -3500,7 +3518,12 @@ PP(pp_entereval) ret = doeval(gimme, NULL, runcv, seq); if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */ && ret != PL_op->op_next) { /* Successive compilation. */ - strcpy(safestr, "_<(eval )"); /* Anything fake and short. */ + /* Copy in anything fake and short. */ +#ifdef HAS_STRLCPY + strlcpy(safestr, fakestr, fakelen); +#else + strcpy(safestr, fakestr); +#endif /* #ifdef HAS_STRLCPY */ } return DOCATCH(ret); } @@ -3561,7 +3584,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", nsv); + retop = Perl_die(aTHX_ "%"SVf" did not return a true value", (void*)nsv); /* die_where() did LEAVE, or we won't be here */ } else { @@ -3622,7 +3645,7 @@ Perl_create_eval_scope(pTHX_ U32 flags) PP(pp_entertry) { dVAR; - PERL_CONTEXT *cx = create_eval_scope(0); + PERL_CONTEXT * const cx = create_eval_scope(0); cx->blk_eval.retop = cLOGOP->op_other->op_next; return DOCATCH(PL_op->op_next); } @@ -3892,7 +3915,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) if (c == 0) PUSHs(&PL_sv_no); else if (SvTEMP(TOPs)) - SvREFCNT_inc(TOPs); + SvREFCNT_inc_void(TOPs); FREETMPS; LEAVE; RETURN; @@ -4133,7 +4156,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) if (c == 0) PUSHs(&PL_sv_undef); else if (SvTEMP(TOPs)) - SvREFCNT_inc(TOPs); + SvREFCNT_inc_void(TOPs); if (SM_OTHER_REF(PVCV)) { /* This one has to be null-proto'd too. @@ -4144,7 +4167,7 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other) if (c == 0) PUSHs(&PL_sv_undef); else if (SvTEMP(TOPs)) - SvREFCNT_inc(TOPs); + SvREFCNT_inc_void(TOPs); FREETMPS; LEAVE; PUTBACK; @@ -4538,9 +4561,13 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) int status = 0; SV *upstream; STRLEN got_len; - const char *got_p; + const char *got_p = NULL; const char *prune_from = NULL; bool read_from_cache = FALSE; + STRLEN umaxlen; + + assert(maxlen >= 0); + umaxlen = maxlen; /* I was having segfault trouble under Linux 2.2.5 after a parse error occured. (Had to hack around it with a test @@ -4554,13 +4581,13 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) const char *cache_p = SvPV(cache, cache_len); STRLEN take = 0; - if (maxlen) { + if (umaxlen) { /* Running in block mode and we have some cached data already. */ - if (cache_len >= maxlen) { + if (cache_len >= umaxlen) { /* In fact, so much data we don't even need to call filter_read. */ - take = maxlen; + take = umaxlen; } } else { const char *const first_nl = memchr(cache_p, '\n', cache_len); @@ -4576,8 +4603,8 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) } sv_catsv(buf_sv, cache); - if (maxlen) { - maxlen -= cache_len; + if (umaxlen) { + umaxlen -= cache_len; } SvOK_off(cache); read_from_cache = TRUE; @@ -4630,9 +4657,9 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) if(SvOK(upstream)) { got_p = SvPV(upstream, got_len); - if (maxlen) { - if (got_len > maxlen) { - prune_from = got_p + maxlen; + if (umaxlen) { + if (got_len > umaxlen) { + prune_from = got_p + umaxlen; } } else { const char *const first_nl = memchr(got_p, '\n', got_len); @@ -4648,7 +4675,7 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) SV *cache = (SV *)IoFMT_GV(datasv); if (!cache) { - IoFMT_GV(datasv) = (GV*) (cache = newSV(got_len - maxlen)); + IoFMT_GV(datasv) = (GV*) (cache = newSV(got_len - umaxlen)); } else if (SvOK(cache)) { /* Cache should be empty. */ assert(!SvCUR(cache));