{
PADOFFSET off;
- /* complain about "my $_" etc etc */
+ /* complain about "my $<special_var>" etc etc */
if (!(PL_in_my == KEY_our ||
isALPHA(name[1]) ||
(USE_UTF8_IN_NAMES && UTF8_IS_START(name[1])) ||
- (name[1] == '_' && (int)strlen(name) > 2)))
+ (name[1] == '_' && (*name == '$' || (int)strlen(name) > 2))))
{
if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
/* 1999-02-27 mjd@plover.com */
Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
{
OP *o;
+ bool ismatchop = 0;
if (ckWARN(WARN_MISC) &&
(left->op_type == OP_RV2AV ||
no_bareword_allowed(right);
}
- if (!(right->op_flags & OPf_STACKED) &&
- (right->op_type == OP_MATCH ||
- right->op_type == OP_SUBST ||
- right->op_type == OP_TRANS)) {
+ ismatchop = right->op_type == OP_MATCH ||
+ right->op_type == OP_SUBST ||
+ right->op_type == OP_TRANS;
+ if (ismatchop && right->op_private & OPpTARGET_MY) {
+ right->op_targ = 0;
+ right->op_private &= ~OPpTARGET_MY;
+ }
+ if (!(right->op_flags & OPf_STACKED) && ismatchop) {
right->op_flags |= OPf_STACKED;
if (right->op_type != OP_MATCH &&
! (right->op_type == OP_TRANS &&
Perl_block_start(pTHX_ int full)
{
int retval = PL_savestack_ix;
- /* If there were syntax errors, don't try to start a block */
- if (PL_yynerrs) return retval;
-
pad_block_start(full);
SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
{
int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
OP* retval = scalarseq(seq);
- /* If there were syntax errors, don't try to close a block */
- if (PL_yynerrs) return retval;
LEAVE_SCOPE(floor);
PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
if (needblockscope)
STATIC OP *
S_newDEFSVOP(pTHX)
{
- return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
+ I32 offset = pad_findmy("$_");
+ if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
+ return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
+ }
+ else {
+ OP *o = newOP(OP_PADSV, 0);
+ o->op_targ = offset;
+ return o;
+ }
}
void
if (o->op_type == OP_STUB) {
PL_comppad_name = 0;
PL_compcv = 0;
+ FreeOp(o);
return;
}
PL_main_root = scope(sawparens(scalarvoid(o)));
&& PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',')
{
char *s = PL_bufptr;
- int sigil = 0;
+ bool sigil = FALSE;
/* some heuristics to detect a potential error */
- while (*s && (strchr(", \t\n", *s)
- || (strchr("@$%*", *s) && ++sigil) ))
+ while (*s && (strchr(", \t\n", *s)))
s++;
- if (sigil) {
- while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s)
- || strchr("@$%*, \t\n", *s)))
- s++;
- if (*s == ';' || *s == '=')
- Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
+ while (1) {
+ if (*s && strchr("@$%*", *s) && *++s
+ && (isALNUM(*s) || UTF8_IS_CONTINUED(*s))) {
+ s++;
+ sigil = TRUE;
+ while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s)))
+ s++;
+ while (*s && (strchr(", \t\n", *s)))
+ s++;
+ }
+ else
+ break;
+ }
+ if (sigil && (*s == ';' || *s == '=')) {
+ Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
"Parentheses missing around \"%s\" list",
lex ? (PL_in_my == KEY_our ? "our" : "my")
: "local");
}
}
if (first->op_type == OP_CONST) {
- if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE)) {
- if (first->op_private & OPpCONST_STRICT)
- no_bareword_allowed(first);
- else
+ if (first->op_private & OPpCONST_STRICT)
+ no_bareword_allowed(first);
+ else if (ckWARN(WARN_BAREWORD) && (first->op_private & OPpCONST_BARE))
Perl_warner(aTHX_ packWARN(WARN_BAREWORD), "Bareword found in conditional");
- }
if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
op_free(first);
*firstp = Nullop;
Perl_croak(aTHX_ "Can't use %s for loop variable", PL_op_desc[sv->op_type]);
}
else {
- sv = newGVOP(OP_GV, 0, PL_defgv);
+ I32 offset = pad_findmy("$_");
+ if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
+ sv = newGVOP(OP_GV, 0, PL_defgv);
+ }
+ else {
+ padoff = offset;
+ iterpflags = OPpLVAL_INTRO; /* my $_; for () */
+ }
}
if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
/* transfer PL_compcv to cv */
cv_undef(cv);
CvFLAGS(cv) = CvFLAGS(PL_compcv);
+ if (!CvWEAKOUTSIDE(cv))
+ SvREFCNT_dec(CvOUTSIDE(cv));
CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv);
CvOUTSIDE(PL_compcv) = 0;
mod(scalarseq(block), OP_LEAVESUBLV));
}
else {
+ /* This makes sub {}; work as expected. */
+ if (block->op_type == OP_STUB) {
+ op_free(block);
+ block = newSTATEOP(0, Nullch, 0);
+ }
CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
}
CvROOT(cv)->op_private |= OPpREFCOUNTED;
Perl_ck_concat(pTHX_ OP *o)
{
OP *kid = cUNOPo->op_first;
- if (kid->op_type == OP_CONCAT && !(kUNOP->op_first->op_flags & OPf_MOD))
+ if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) &&
+ !(kUNOP->op_first->op_flags & OPf_MOD))
o->op_flags |= OPf_STACKED;
return o;
}
OP_IS_FILETEST_ACCESS(o))
o->op_private |= OPpFT_ACCESS;
}
+ if (PL_check[kid->op_type] == MEMBER_TO_FPTR(Perl_ck_ftst)
+ && kid->op_type != OP_STAT && kid->op_type != OP_LSTAT)
+ o->op_private |= OPpFT_STACKED;
}
else {
op_free(o);
}
if (tmpstr) {
- name = savepv(SvPVX(tmpstr));
- len = strlen(name);
+ name = SvPV(tmpstr, len);
sv_2mortal(tmpstr);
}
}
o->op_ppaddr = PL_ppaddr[OP_LIST];
cLISTOPo->op_first->op_type = OP_PUSHMARK;
cLISTOPo->op_first->op_ppaddr = PL_ppaddr[OP_PUSHMARK];
+ cLISTOPo->op_first->op_targ = 0;
o = newUNOP(OP_ENTERSUB, OPf_STACKED,
append_elem(OP_LIST, o,
scalar(newUNOP(OP_RV2CV, 0,
LOGOP *gwop;
OP *kid;
OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
+ I32 offset;
o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
NewOp(1101, gwop, 1, LOGOP);
gwop->op_ppaddr = PL_ppaddr[type];
gwop->op_first = listkids(o);
gwop->op_flags |= OPf_KIDS;
- gwop->op_private = 1;
gwop->op_other = LINKLIST(kid);
- gwop->op_targ = pad_alloc(type, SVs_PADTMP);
kid->op_next = (OP*)gwop;
+ offset = pad_findmy("$_");
+ if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
+ o->op_private = gwop->op_private = 0;
+ gwop->op_targ = pad_alloc(type, SVs_PADTMP);
+ }
+ else {
+ o->op_private = gwop->op_private = OPpGREP_LEX;
+ gwop->op_targ = o->op_targ = offset;
+ }
kid = cLISTOPo->op_first->op_sibling;
if (!kid || !kid->op_sibling)
OP *
Perl_ck_match(pTHX_ OP *o)
{
- o->op_private |= OPpRUNTIME;
+ if (o->op_type != OP_QR) {
+ I32 offset = pad_findmy("$_");
+ if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS(offset) & SVpad_OUR)) {
+ o->op_targ = offset;
+ o->op_private |= OPpTARGET_MY;
+ }
+ }
+ if (o->op_type == OP_MATCH || o->op_type == OP_QR)
+ o->op_private |= OPpRUNTIME;
return o;
}
}
OP *
+Perl_ck_unpack(pTHX_ OP *o)
+{
+ OP *kid = cLISTOPo->op_first;
+ if (kid->op_sibling) {
+ kid = kid->op_sibling;
+ if (!kid->op_sibling)
+ kid->op_sibling = newDEFSVOP();
+ }
+ return ck_fun(o);
+}
+
+OP *
Perl_ck_substr(pTHX_ OP *o)
{
o = ck_fun(o);
o->op_seq = PL_op_seqmax++;
break;
case OP_STUB:
- /* XXX This makes sub {}; work as expected.
- ie {return;} not {return @_;}
- When optimiser is properly split into fixups and
- optimisations, this needs to stay in the fixups. */
- if(!oldop &&
- o->op_next &&
- o->op_next->op_type == OP_LEAVESUB) {
- OP* newop = newSTATEOP(0, Nullch, 0);
- newop->op_next = o->op_next;
- o->op_next = 0;
- op_free(o);
- o = newop;
- ((UNOP*)o->op_next)->op_first = newop;
- CvSTART(PL_compcv) = newop;
- }
if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
o->op_seq = PL_op_seqmax++;
break; /* Scalar stub must produce undef. List stub is noop */
https://perl5.git.perl.org / perl5.git / blobdiff