RETURN;
}
- EXTEND(SP, 10);
+ EXTEND(SP, 11);
if (!stashname)
PUSHs(&PL_sv_undef);
/* XXX only hints propagated via op_private are currently
* visible (others are not easily accessible, since they
* use the global PL_hints) */
- PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->op_private &
- HINT_PRIVATE_MASK)));
+ PUSHs(sv_2mortal(newSViv(CopHINTS_get(cx->blk_oldcop))));
{
SV * mask ;
- SV * const old_warnings = cx->blk_oldcop->cop_warnings ;
+ STRLEN * const old_warnings = cx->blk_oldcop->cop_warnings ;
if (old_warnings == pWARN_NONE ||
(old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0))
}
}
else
- mask = newSVsv(old_warnings);
+ mask = newSVpvn((char *) (old_warnings + 1), old_warnings[0]);
PUSHs(sv_2mortal(mask));
}
+
+ PUSHs(cx->blk_oldcop->cop_hints ?
+ sv_2mortal(newRV_noinc(
+ (SV*)Perl_refcounted_he_chain_2hv(aTHX_
+ cx->blk_oldcop->cop_hints)))
+ : &PL_sv_undef);
RETURN;
}
*padp = (AV*)SvREFCNT_inc_simple(PL_comppad);
LEAVE;
if (IN_PERL_COMPILETIME)
- PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+ CopHINTS_set(&PL_compiling, PL_hints);
#ifdef OP_IN_REGISTER
op = PL_opsave;
#endif
PL_eval_root = NULL;
PL_error_count = 0;
PL_curcop = &PL_compiling;
- PL_curcop->cop_arybase = 0;
+ CopARYBASE_set(PL_curcop, 0);
if (saveop && (saveop->op_type != OP_REQUIRE) && (saveop->op_flags & OPf_SPECIAL))
PL_in_eval |= EVAL_KEEPERR;
else
const I32 gimme = GIMME_V;
int filter_has_file = 0;
PerlIO *tryrsfp = NULL;
- GV *filter_child_proc = NULL;
SV *filter_state = NULL;
SV *filter_sub = NULL;
SV *hook_sv = NULL;
if (io) {
tryrsfp = IoIFP(io);
- if (IoTYPE(io) == IoTYPE_PIPE) {
- /* reading from a child process doesn't
- nest -- when returning from reading
- the inner module, the outer one is
- unreadable (closed?) I've tried to
- save the gv to manage the lifespan of
- the pipe, but this didn't help. XXX */
- filter_child_proc = (GV *)arg;
- SvREFCNT_inc_simple_void(filter_child_proc);
- }
- else {
- if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
- PerlIO_close(IoOFP(io));
- }
- IoIFP(io) = NULL;
- IoOFP(io) = NULL;
+ if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
+ PerlIO_close(IoOFP(io));
}
+ IoIFP(io) = NULL;
+ IoOFP(io) = NULL;
}
if (i < count) {
}
if (!tryrsfp) {
- tryrsfp = PerlIO_open("/dev/null", PERL_SCRIPT_MODE);
+ tryrsfp = PerlIO_open(BIT_BUCKET,
+ PERL_SCRIPT_MODE);
}
}
SP--;
}
filter_has_file = 0;
- if (filter_child_proc) {
- SvREFCNT_dec(filter_child_proc);
- filter_child_proc = NULL;
- }
if (filter_state) {
SvREFCNT_dec(filter_state);
filter_state = NULL;
PL_rsfp = tryrsfp;
SAVEHINTS();
PL_hints = 0;
- SAVESPTR(PL_compiling.cop_warnings);
+ SAVECOMPILEWARNINGS();
if (PL_dowarn & G_WARN_ALL_ON)
PL_compiling.cop_warnings = pWARN_ALL ;
else if (PL_dowarn & G_WARN_ALL_OFF)
PL_compiling.cop_warnings = pWARN_NONE ;
- else if (PL_taint_warn)
- PL_compiling.cop_warnings = newSVpvn(WARN_TAINTstring, WARNsize);
+ else if (PL_taint_warn) {
+ PL_compiling.cop_warnings
+ = Perl_new_warnings_bitfield(aTHX_ NULL, WARN_TAINTstring, WARNsize);
+ }
else
PL_compiling.cop_warnings = pWARN_STD ;
SAVESPTR(PL_compiling.cop_io);
PL_compiling.cop_io = NULL;
- if (filter_sub || filter_child_proc) {
+ if (filter_sub) {
SV * const datasv = filter_add(S_run_user_filter, NULL);
IoLINES(datasv) = filter_has_file;
- IoFMT_GV(datasv) = (GV *)filter_child_proc;
IoTOP_GV(datasv) = (GV *)filter_state;
IoBOTTOM_GV(datasv) = (GV *)filter_sub;
}
PL_hints = PL_op->op_targ;
if (saved_hh)
GvHV(PL_hintgv) = saved_hh;
- SAVESPTR(PL_compiling.cop_warnings);
- if (specialWARN(PL_curcop->cop_warnings))
- PL_compiling.cop_warnings = PL_curcop->cop_warnings;
- else {
- PL_compiling.cop_warnings = newSVsv(PL_curcop->cop_warnings);
- SAVEFREESV(PL_compiling.cop_warnings);
- }
+ SAVECOMPILEWARNINGS();
+ PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
SAVESPTR(PL_compiling.cop_io);
if (specialCopIO(PL_curcop->cop_io))
PL_compiling.cop_io = PL_curcop->cop_io;
PL_compiling.cop_io = newSVsv(PL_curcop->cop_io);
SAVEFREESV(PL_compiling.cop_io);
}
+ if (PL_compiling.cop_hints) {
+ Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints);
+ }
+ PL_compiling.cop_hints = PL_curcop->cop_hints;
+ if (PL_compiling.cop_hints) {
+ HINTS_REFCNT_LOCK;
+ PL_compiling.cop_hints->refcounted_he_refcnt++;
+ HINTS_REFCNT_UNLOCK;
+ }
/* special case: an eval '' executed within the DB package gets lexically
* placed in the first non-DB CV rather than the current CV - this
* allows the debugger to execute code, find lexicals etc, in the
PUSHs(other);
PUSHs(*svp);
PUTBACK;
- if ((PL_curcop->op_private & HINT_INTEGER) == HINT_INTEGER)
+ if (CopHINTS_get(PL_curcop) & HINT_INTEGER)
(void) pp_i_eq();
else
(void) pp_eq();
/* Otherwise, numeric comparison */
PUSHs(d); PUSHs(e);
PUTBACK;
- if ((PL_curcop->op_private & HINT_INTEGER) == HINT_INTEGER)
+ if (CopHINTS_get(PL_curcop) & HINT_INTEGER)
(void) pp_i_eq();
else
(void) pp_eq();
dVAR;
SV * const datasv = FILTER_DATA(idx);
const int filter_has_file = IoLINES(datasv);
- GV * const filter_child_proc = (GV *)IoFMT_GV(datasv);
SV * const filter_state = (SV *)IoTOP_GV(datasv);
SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv);
int len = 0;
-
+ /* Filter API says that the filter appends to the contents of the buffer.
+ Usually the buffer is "", so the details don't matter. But if it's not,
+ then clearly what it contains is already filtered by this filter, so we
+ don't want to pass it in a second time.
+ I'm going to use a mortal in case the upstream filter croaks. */
+ SV *const upstream
+ = ((SvOK(buf_sv) && sv_len(buf_sv)) || SvGMAGICAL(buf_sv))
+ ? sv_newmortal() : buf_sv;
+
+ SvUPGRADE(upstream, SVt_PV);
/* I was having segfault trouble under Linux 2.2.5 after a
parse error occured. (Had to hack around it with a test
for PL_error_count == 0.) Solaris doesn't segfault --
not sure where the trouble is yet. XXX */
+ if (maxlen && IoFMT_GV(datasv)) {
+ SV *const cache = (SV *)IoFMT_GV(datasv);
+ if (SvOK(cache)) {
+ STRLEN cache_len;
+ const char *cache_p = SvPV(cache, cache_len);
+ /* Running in block mode and we have some cached data already. */
+ if (cache_len >= maxlen) {
+ /* In fact, so much data we don't even need to call
+ filter_read. */
+ sv_catpvn(buf_sv, cache_p, maxlen);
+ sv_chop(cache, cache_p + maxlen);
+ /* Definately not EOF */
+ return 1;
+ }
+ sv_catsv(buf_sv, cache);
+ maxlen -= cache_len;
+ SvOK_off(cache);
+ }
+ }
+
if (filter_has_file) {
- len = FILTER_READ(idx+1, buf_sv, maxlen);
+ len = FILTER_READ(idx+1, upstream, maxlen);
}
if (filter_sub && len >= 0) {
SAVETMPS;
EXTEND(SP, 2);
- DEFSV = buf_sv;
+ DEFSV = upstream;
PUSHMARK(SP);
PUSHs(sv_2mortal(newSViv(maxlen)));
if (filter_state) {
LEAVE;
}
+ if (maxlen) {
+ /* Running in block mode. */
+ STRLEN got_len;
+ const char *got_p = SvPV(upstream, got_len);
+
+ if (got_len > maxlen) {
+ /* Oh. Too long. Stuff some in our cache. */
+ SV *cache = (SV *)IoFMT_GV(datasv);
+
+ if (!cache) {
+ IoFMT_GV(datasv) = (GV*) (cache = newSV(got_len - maxlen));
+ } else if (SvOK(cache)) {
+ /* Cache should be empty. */
+ assert(!SvCUR(cache));
+ }
+
+ sv_setpvn(cache, got_p + maxlen, got_len - maxlen);
+ /* If you ask for block mode, you may well split UTF-8 characters.
+ "If it breaks, you get to keep both parts"
+ (Your code is broken if you don't put them back together again
+ before something notices.) */
+ if (SvUTF8(upstream)) {
+ SvUTF8_on(cache);
+ }
+ SvCUR_set(upstream, maxlen);
+ }
+ }
+
+ if (upstream != buf_sv) {
+ sv_catsv(buf_sv, upstream);
+ }
+
if (len <= 0) {
IoLINES(datasv) = 0;
- if (filter_child_proc) {
- SvREFCNT_dec(filter_child_proc);
- IoFMT_GV(datasv) = NULL;
- }
+ SvREFCNT_dec(IoFMT_GV(datasv));
if (filter_state) {
SvREFCNT_dec(filter_state);
IoTOP_GV(datasv) = NULL;
}
filter_del(S_run_user_filter);
}
-
return len;
}