/* 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));
}
*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
PL_rsfp = tryrsfp;
SAVEHINTS();
PL_hints = 0;
- SAVESPTR(PL_compiling.cop_warnings);
+ SAVECOPWARNINGS(&PL_compiling);
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(NULL, WARN_TAINTstring, WARNsize);
+ }
else
PL_compiling.cop_warnings = pWARN_STD ;
SAVESPTR(PL_compiling.cop_io);
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);
- }
+ SAVECOPWARNINGS(&PL_compiling);
+ 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;
SAVEFREESV(PL_compiling.cop_io);
}
if (PL_compiling.cop_hints) {
- PL_compiling.cop_hints->refcounted_he_refcnt--;
+ Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints);
}
PL_compiling.cop_hints = PL_curcop->cop_hints;
if (PL_compiling.cop_hints) {
-#ifdef USE_ITHREADS
- /* PL_curcop could be pointing to an optree owned by another /.*parent/
- thread. We can't manipulate the reference count of the refcounted he
- there (race condition) so we have to do something less than
- pleasant to keep it read only. The simplest solution seems to be to
- copy their chain. We might want to cache this.
- Alternatively we could add a flag to the refcounted he *we* point to
- here saying "I don't own a reference count on the thing I point to",
- and arrange for Perl_refcounted_he_free() to spot that. If so, we'd
- still need to copy the topmost refcounted he so that we could change
- its flag. So still not trivial. (Flag bits could be hung from the
- shared HEK) */
- PL_compiling.cop_hints
- = Perl_refcounted_he_copy(aTHX_ PL_compiling.cop_hints);
-#else
+ HINTS_REFCNT_LOCK;
PL_compiling.cop_hints->refcounted_he_refcnt++;
-#endif
+ 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
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();