This is a live mirror of the Perl 5 development currently hosted at
https://github.com/perl/perl5
https://perl5.git.perl.org
/
perl5.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Document SvGAMAGIC(), and its significance w.r.t. the side effects of
[perl5.git]
/
pp_ctl.c
diff --git
a/pp_ctl.c
b/pp_ctl.c
index
5e44789
..
f88d401
100644
(file)
--- 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();
/* 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);
sprintf(t, fmt, (int) fieldsize, (int) arg & 255, value);
+#endif /* ifdef USE_SNPRINTF */
RESTORE_NUMERIC_STANDARD();
}
t += fieldsize;
RESTORE_NUMERIC_STANDARD();
}
t += fieldsize;
@@
-1450,7
+1454,7
@@
Perl_qerror(pTHX_ SV *err)
else if (PL_errors)
sv_catsv(PL_errors, err);
else
else if (PL_errors)
sv_catsv(PL_errors, err);
else
- Perl_warn(aTHX_ "%"SVf, err);
+ Perl_warn(aTHX_ "%"SVf,
(void*)
err);
++PL_error_count;
}
++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);
/* 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:
}
break;
case CXt_FORMAT:
@@
-2320,7
+2324,7
@@
PP(pp_goto)
goto retry;
tmpstr = sv_newmortal();
gv_efullname3(tmpstr, gv, NULL);
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");
}
}
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
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);
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);
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 *
}
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);
{
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;
}
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",
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",
}
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;
}
RETPUSHYES;
@@
-3138,7
+3148,7
@@
PP(pp_require)
{
namesv = newSV(0);
for (i = 0; i <= AvFILL(ar); i++) {
{
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;
if (SvROK(dirsv)) {
int count;
@@
-3191,7
+3201,7
@@
PP(pp_require)
}
if (SvTYPE(arg) == SVt_PVGV) {
}
if (SvTYPE(arg) == SVt_PVGV) {
- IO *io = GvIO((GV *)arg);
+ IO *
const
io = GvIO((GV *)arg);
++filter_has_file;
++filter_has_file;
@@
-3422,6
+3432,10
@@
PP(pp_entereval)
CV* runcv;
U32 seq;
HV *saved_hh = NULL;
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);
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
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);
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);
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. */
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);
}
}
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);
/* 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 {
/* 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;
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);
}
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))
if (c == 0)
PUSHs(&PL_sv_no);
else if (SvTEMP(TOPs))
- SvREFCNT_inc(TOPs);
+ SvREFCNT_inc
_void
(TOPs);
FREETMPS;
LEAVE;
RETURN;
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))
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.
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))
if (c == 0)
PUSHs(&PL_sv_undef);
else if (SvTEMP(TOPs))
- SvREFCNT_inc(TOPs);
+ SvREFCNT_inc
_void
(TOPs);
FREETMPS;
LEAVE;
PUTBACK;
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;
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;
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
/* 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;
const char *cache_p = SvPV(cache, cache_len);
STRLEN take = 0;
- if (maxlen) {
+ if (
u
maxlen) {
/* Running in block mode and we have some cached data already.
*/
/* Running in block mode and we have some cached data already.
*/
- if (cache_len >= maxlen) {
+ if (cache_len >=
u
maxlen) {
/* In fact, so much data we don't even need to call
filter_read. */
/* In fact, so much data we don't even need to call
filter_read. */
- take = maxlen;
+ take =
u
maxlen;
}
} else {
const char *const first_nl = memchr(cache_p, '\n', cache_len);
}
} 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);
}
sv_catsv(buf_sv, cache);
- if (maxlen) {
- maxlen -= cache_len;
+ if (
u
maxlen) {
+
u
maxlen -= cache_len;
}
SvOK_off(cache);
read_from_cache = TRUE;
}
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(SvOK(upstream)) {
got_p = SvPV(upstream, got_len);
- if (maxlen) {
- if (got_len > maxlen) {
- prune_from = got_p + maxlen;
+ if (
u
maxlen) {
+ if (got_len >
u
maxlen) {
+ prune_from = got_p +
u
maxlen;
}
} else {
const char *const first_nl = memchr(got_p, '\n', got_len);
}
} 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) {
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 -
u
maxlen));
} else if (SvOK(cache)) {
/* Cache should be empty. */
assert(!SvCUR(cache));
} else if (SvOK(cache)) {
/* Cache should be empty. */
assert(!SvCUR(cache));