Nullop ) \
: (CHECKCALL[type])((OP*)o))
+#define PAD_MAX 999999999
+
static bool scalar_mod_type _((OP *o, I32 type));
#ifndef PERL_OBJECT
static I32 list_assignment _((OP *o));
static OP *too_many_arguments _((OP *o, char* name));
static void null _((OP* o));
static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
- CV* startcv, I32 cx_ix));
+ CV* startcv, I32 cx_ix, I32 saweval));
static OP *newDEFSVOP _((void));
static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
#endif
for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
if ((sv = svp[off])
&& sv != &PL_sv_undef
+ && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
&& strEQ(name, SvPVX(sv)))
{
warner(WARN_UNSAFE,
"\"my\" variable %s masks earlier declaration in same %s",
- name, (SvIVX(sv) == 999999999 ? "scope" : "statement"));
+ name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
break;
}
}
PL_sv_objcount++;
}
av_store(PL_comppad_name, off, sv);
- SvNVX(sv) = (double)999999999;
+ SvNVX(sv) = (double)PAD_MAX;
SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
if (!PL_min_intro_pending)
PL_min_intro_pending = off;
}
STATIC PADOFFSET
-pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
+pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval)
{
dTHR;
CV *cv;
SV *sv;
register I32 i;
register PERL_CONTEXT *cx;
- int saweval;
for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
AV *curlist = CvPADLIST(cv);
sv_setpv(namesv, name);
av_store(PL_comppad_name, newoff, namesv);
SvNVX(namesv) = (double)PL_curcop->cop_seq;
- SvIVX(namesv) = 999999999; /* A ref, intro immediately */
+ SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */
SvFAKE_on(namesv); /* A ref, not a real var */
+ if (SvOBJECT(sv)) { /* A typed var */
+ SvOBJECT_on(namesv);
+ (void)SvUPGRADE(namesv, SVt_PVMG);
+ SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(sv));
+ PL_sv_objcount++;
+ }
if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
/* "It's closures all the way down." */
CvCLONE_on(PL_compcv);
CV *bcv;
for (bcv = startcv;
bcv && bcv != cv && !CvCLONE(bcv);
- bcv = CvOUTSIDE(bcv)) {
+ bcv = CvOUTSIDE(bcv))
+ {
if (CvANON(bcv))
CvCLONE_on(bcv);
else {
- if (ckWARN(WARN_CLOSURE) && !CvUNIQUE(cv))
+ if (ckWARN(WARN_CLOSURE)
+ && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
+ {
warner(WARN_CLOSURE,
"Variable \"%s\" may be unavailable",
name);
+ }
break;
}
}
* XXX This will also probably interact badly with eval tree caching.
*/
- saweval = 0;
for (i = cx_ix; i >= 0; i--) {
cx = &cxstack[i];
- switch (cx->cx_type) {
+ switch (CxTYPE(cx)) {
default:
if (i == 0 && saweval) {
seq = cxstack[saweval].blk_oldcop->cop_seq;
- return pad_findlex(name, newoff, seq, PL_main_cv, 0);
+ return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval);
}
break;
case CXt_EVAL:
switch (cx->blk_eval.old_op_type) {
case OP_ENTEREVAL:
- saweval = i;
+ if (CxREALEVAL(cx))
+ saweval = i;
break;
case OP_REQUIRE:
/* require must have its own scope */
continue;
}
seq = cxstack[saweval].blk_oldcop->cop_seq;
- return pad_findlex(name, newoff, seq, cv, i-1);
+ return pad_findlex(name, newoff, seq, cv, i-1, saweval);
}
}
SV *sv;
SV **svp = AvARRAY(PL_comppad_name);
U32 seq = PL_cop_seqmax;
+ PERL_CONTEXT *cx;
+ CV *outside;
#ifdef USE_THREADS
/*
}
}
+ outside = CvOUTSIDE(PL_compcv);
+
+ /* Check if if we're compiling an eval'', and adjust seq to be the
+ * eval's seq number. This depends on eval'' having a non-null
+ * CvOUTSIDE() while it is being compiled. The eval'' itself is
+ * identified by CvUNIQUE being set and CvGV being null. */
+ if (outside && CvUNIQUE(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
+ cx = &cxstack[cxstack_ix];
+ if (CxREALEVAL(cx))
+ seq = cx->blk_oldcop->cop_seq;
+ }
+
/* See if it's in a nested scope */
- off = pad_findlex(name, 0, seq, CvOUTSIDE(PL_compcv), cxstack_ix);
+ off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0);
if (off) {
/* If there is a pending local definition, this new alias must die */
if (pendoff)
}
/* "Deintroduce" my variables that are leaving with this scope. */
for (off = AvFILLp(PL_comppad_name); off > fill; off--) {
- if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == 999999999)
+ if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == PAD_MAX)
SvIVX(sv) = PL_cop_seqmax;
}
}
PL_pad_reset_pending = FALSE;
SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
- SAVEPPTR(compiling.cop_warnings);
+ SAVEPPTR(PL_compiling.cop_warnings);
if (PL_compiling.cop_warnings != WARN_ALL &&
PL_compiling.cop_warnings != WARN_NONE) {
PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
OP* retval = scalarseq(seq);
LEAVE_SCOPE(floor);
PL_pad_reset_pending = FALSE;
- compiling.op_private = PL_hints;
+ PL_compiling.op_private = PL_hints;
if (needblockscope)
PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
pad_leavemy(PL_comppad_name_fill);
first->op_last = last->op_last;
first->op_children += last->op_children;
if (first->op_children)
- last->op_flags |= OPf_KIDS;
+ first->op_flags |= OPf_KIDS;
Safefree(last);
return (OP*)first;
OP *rqop;
OP *imop;
OP *veop;
+ GV *gv;
if (id->op_type != OP_CONST)
croak("Module name must be constant");
newUNOP(OP_METHOD, 0, meth)));
}
- /* Fake up a require */
- rqop = newUNOP(OP_REQUIRE, 0, id);
+ /* Fake up a require, handle override, if any */
+ gv = gv_fetchpv("require", FALSE, SVt_PVCV);
+ if (!(gv && GvIMPORTED_CV(gv)))
+ gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
+
+ if (gv && GvIMPORTED_CV(gv)) {
+ rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, id,
+ scalar(newUNOP(OP_RV2CV, 0,
+ newGVOP(OP_GV, 0,
+ gv))))));
+ }
+ else {
+ rqop = newUNOP(OP_REQUIRE, 0, id);
+ }
/* Fake up the BEGIN {}, which does its thing immediately. */
newSUB(floor,
}
OP *
+dofile(OP *term)
+{
+ OP *doop;
+ GV *gv;
+
+ gv = gv_fetchpv("do", FALSE, SVt_PVCV);
+ if (!(gv && GvIMPORTED_CV(gv)))
+ gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV);
+
+ if (gv && GvIMPORTED_CV(gv)) {
+ doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+ append_elem(OP_LIST, term,
+ scalar(newUNOP(OP_RV2CV, 0,
+ newGVOP(OP_GV, 0,
+ gv))))));
+ }
+ else {
+ doop = newUNOP(OP_DOFILE, 0, scalar(term));
+ }
+ return doop;
+}
+
+OP *
newSLICEOP(I32 flags, OP *subscript, OP *listval)
{
return newBINOP(OP_LSLICE, flags,
#ifdef NATIVE_HINTS
cop->op_private |= NATIVE_HINTS;
#endif
- compiling.op_private = cop->op_private;
+ PL_compiling.op_private = cop->op_private;
cop->op_next = (OP*)cop;
if (label) {
svp = AvARRAY(PL_comppad_name);
for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
- SvIVX(sv) = 999999999; /* Don't know scope end yet. */
+ SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
SvNVX(sv) = (double)PL_cop_seqmax;
}
}
cv,
(CvANON(cv) ? "ANON"
: (cv == PL_main_cv) ? "MAIN"
- : CvUNIQUE(outside) ? "UNIQUE"
+ : CvUNIQUE(cv) ? "UNIQUE"
: CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
outside,
(!outside ? "null"
char *name = SvPVX(namesv); /* XXX */
if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */
I32 off = pad_findlex(name, ix, SvIVX(namesv),
- CvOUTSIDE(cv), cxstack_ix);
+ CvOUTSIDE(cv), cxstack_ix, 0);
if (!off)
PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
else if (off != ix)
CvSTASH(cv) = PL_curstash;
#ifdef USE_THREADS
CvOWNER(cv) = 0;
- if (!CvMUTEXP(cv))
+ if (!CvMUTEXP(cv)) {
New(666, CvMUTEXP(cv), 1, perl_mutex);
- MUTEX_INIT(CvMUTEXP(cv));
+ MUTEX_INIT(CvMUTEXP(cv));
+ }
#endif /* USE_THREADS */
if (ps)
projects / p5sagit/p5-mst-13.2.git / blobdiff