goto clear_pmop;
case OP_PUSHRE:
#ifdef USE_ITHREADS
- if ((PADOFFSET)cPMOPo->op_pmreplroot) {
+ if (INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot)) {
if (PL_curpad) {
- GV *gv = (GV*)PL_curpad[(PADOFFSET)cPMOPo->op_pmreplroot];
- pad_swipe((PADOFFSET)cPMOPo->op_pmreplroot);
+ GV *gv = (GV*)PL_curpad[INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot)];
+ pad_swipe(INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot));
/* No GvIN_PAD_off(gv) here, because other references may still
* exist on the pad */
SvREFCNT_dec(gv);
#ifdef USE_ITHREADS
if(PL_regex_pad) { /* We could be in destruction */
av_push((AV*) PL_regex_pad[0],(SV*) PL_regex_pad[(cPMOPo)->op_pmoffset]);
+ SvREPADTMP_on(PL_regex_pad[(cPMOPo)->op_pmoffset]);
PM_SETRE(cPMOPo, (cPMOPo)->op_pmoffset);
}
#endif
if (kid->op_type != OP_NULL || kid->op_targ != OP_LIST)
Perl_croak(aTHX_
"panic: unexpected lvalue entersub "
- "args: type/targ %ld:%ld",
- (long)kid->op_type,kid->op_targ);
+ "args: type/targ %ld:%"UVuf,
+ (long)kid->op_type, (UV)kid->op_targ);
kid = kLISTOP->op_first;
skip_kids:
while (kid->op_sibling)
if (kid->op_type != OP_RV2CV)
Perl_croak(aTHX_
"panic: unexpected lvalue entersub "
- "entry via type/targ %ld:%ld",
- (long)kid->op_type,kid->op_targ);
+ "entry via type/targ %ld:%"UVuf,
+ (long)kid->op_type, (UV)kid->op_targ);
kid->op_private |= OPpLVAL_INTRO;
break; /* Postpone until runtime */
}
if (kid->op_type == OP_NULL)
Perl_croak(aTHX_
"Unexpected constant lvalue entersub "
- "entry via type/targ %ld:%ld",
- (long)kid->op_type,kid->op_targ);
+ "entry via type/targ %ld:%"UVuf,
+ (long)kid->op_type, (UV)kid->op_targ);
if (kid->op_type != OP_GV) {
/* Restore RV2CV to check lvalueness */
restore_2cv:
Perl_block_end(pTHX_ I32 floor, OP *seq)
{
int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
- OP* retval = scalarseq(seq);
+ line_t copline = PL_copline;
+ /* there should be a nextstate in every block */
+ OP* retval = seq ? scalarseq(seq) : newSTATEOP(0, Nullch, seq);
+ PL_copline = copline; /* XXX newSTATEOP may reset PL_copline */
LEAVE_SCOPE(floor);
PL_pad_reset_pending = FALSE;
PL_compiling.op_private = PL_hints;
if(av_len((AV*) PL_regex_pad[0]) > -1) {
repointer = av_pop((AV*)PL_regex_pad[0]);
pmop->op_pmoffset = SvIV(repointer);
+ SvREPADTMP_off(repointer);
sv_setiv(repointer,0);
} else {
repointer = newSViv(0);
else if (curop->op_type == OP_PUSHRE) {
if (((PMOP*)curop)->op_pmreplroot) {
#ifdef USE_ITHREADS
- GV *gv = (GV*)PL_curpad[(PADOFFSET)((PMOP*)curop)->op_pmreplroot];
+ GV *gv = (GV*)PL_curpad[INT2PTR(PADOFFSET,((PMOP*)curop)->op_pmreplroot)];
#else
GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
#endif
tmpop = ((UNOP*)left)->op_first;
if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
#ifdef USE_ITHREADS
- pm->op_pmreplroot = (OP*)cPADOPx(tmpop)->op_padix;
+ pm->op_pmreplroot = INT2PTR(OP*, cPADOPx(tmpop)->op_padix);
cPADOPx(tmpop)->op_padix = 0; /* steal it */
#else
pm->op_pmreplroot = (OP*)cSVOPx(tmpop)->op_sv;
}
}
-static void const_sv_xsub(pTHXo_ CV* cv);
+static void const_sv_xsub(pTHX_ CV* cv);
/*
=for apidoc cv_const_sv
&& (!const_sv || sv_cmp(cv_const_sv(cv), const_sv))))
{
line_t oldline = CopLINE(PL_curcop);
- CopLINE_set(PL_curcop, PL_copline);
+ if (PL_copline != NOLINE)
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_REDEFINE,
CvCONST(cv) ? "Constant subroutine %s redefined"
: "Subroutine %s redefined", name);
ENTER;
SAVECOPFILE(&PL_compiling);
SAVECOPLINE(&PL_compiling);
- save_svref(&PL_rs);
- sv_setsv(PL_rs, PL_nrs);
if (!PL_beginav)
PL_beginav = newAV();
if ((cv = GvFORM(gv))) {
if (ckWARN(WARN_REDEFINE)) {
line_t oldline = CopLINE(PL_curcop);
-
- CopLINE_set(PL_curcop, PL_copline);
+ if (PL_copline != NOLINE)
+ CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name);
CopLINE_set(PL_curcop, oldline);
}
GV *namegv = 0;
int optional = 0;
I32 arg = 0;
+ I32 contextclass = 0;
+ char *e = 0;
STRLEN n_a;
o->op_private |= OPpENTERSUB_HASTARG;
}
scalar(o2);
break;
+ case '[': case ']':
+ goto oops;
+ break;
case '\\':
proto++;
arg++;
+ again:
switch (*proto++) {
+ case '[':
+ if (contextclass++ == 0) {
+ e = strchr(proto, ']');
+ if (!e || e == proto)
+ goto oops;
+ }
+ else
+ goto oops;
+ goto again;
+ break;
+ case ']':
+ if (contextclass)
+ contextclass = 0;
+ else
+ goto oops;
+ break;
case '*':
- if (o2->op_type != OP_RV2GV)
- bad_type(arg, "symbol", gv_ename(namegv), o2);
- goto wrapref;
+ if (o2->op_type == OP_RV2GV)
+ goto wrapref;
+ if (!contextclass)
+ bad_type(arg, "symbol", gv_ename(namegv), o2);
+ break;
case '&':
- if (o2->op_type != OP_ENTERSUB)
- bad_type(arg, "subroutine entry", gv_ename(namegv), o2);
- goto wrapref;
+ if (o2->op_type == OP_ENTERSUB)
+ goto wrapref;
+ if (!contextclass)
+ bad_type(arg, "subroutine entry", gv_ename(namegv), o2);
+ break;
case '$':
- if (o2->op_type != OP_RV2SV
- && o2->op_type != OP_PADSV
- && o2->op_type != OP_HELEM
- && o2->op_type != OP_AELEM
- && o2->op_type != OP_THREADSV)
- {
+ if (o2->op_type == OP_RV2SV ||
+ o2->op_type == OP_PADSV ||
+ o2->op_type == OP_HELEM ||
+ o2->op_type == OP_AELEM ||
+ o2->op_type == OP_THREADSV)
+ goto wrapref;
+ if (!contextclass)
bad_type(arg, "scalar", gv_ename(namegv), o2);
- }
- goto wrapref;
+ break;
case '@':
- if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
+ if (o2->op_type == OP_RV2AV ||
+ o2->op_type == OP_PADAV)
+ goto wrapref;
+ if (!contextclass)
bad_type(arg, "array", gv_ename(namegv), o2);
- goto wrapref;
+ break;
case '%':
- if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
- bad_type(arg, "hash", gv_ename(namegv), o2);
- wrapref:
+ if (o2->op_type == OP_RV2HV ||
+ o2->op_type == OP_PADHV)
+ goto wrapref;
+ if (!contextclass)
+ bad_type(arg, "hash", gv_ename(namegv), o2);
+ break;
+ wrapref:
{
OP* kid = o2;
OP* sib = kid->op_sibling;
o2->op_sibling = sib;
prev->op_sibling = o2;
}
+ if (contextclass && e) {
+ proto = e + 1;
+ contextclass = 0;
+ }
break;
default: goto oops;
}
+ if (contextclass)
+ goto again;
break;
case ' ':
proto++;
default:
oops:
Perl_croak(aTHX_ "Malformed prototype for %s: %s",
- gv_ename(namegv), SvPV((SV*)cv, n_a));
+ gv_ename(namegv), SvPV((SV*)cv, n_a));
}
}
else
&& o->op_next->op_next->op_type == OP_CONCAT
&& (o->op_next->op_next->op_flags & OPf_STACKED))
{
- /* Turn "$a .= <FH>" into an OP_RCATLINE. AMS 20010811 */
- o->op_next->op_type = OP_RCATLINE;
- o->op_next->op_flags |= OPf_STACKED;
+ /* Turn "$a .= <FH>" into an OP_RCATLINE. AMS 20010917 */
+ o->op_type = OP_RCATLINE;
+ o->op_flags |= OPf_STACKED;
+ o->op_ppaddr = PL_ppaddr[OP_RCATLINE];
op_null(o->op_next->op_next);
+ op_null(o->op_next);
}
o->op_seq = PL_op_seqmax++;
LEAVE;
}
-#ifdef PERL_CUSTOM_OPS
-char* custom_op_name(pTHX_ OP* o)
+
+
+char* Perl_custom_op_name(pTHX_ OP* o)
{
IV index = PTR2IV(o->op_ppaddr);
SV* keysv;
return SvPV_nolen(HeVAL(he));
}
-char* custom_op_desc(pTHX_ OP* o)
+char* Perl_custom_op_desc(pTHX_ OP* o)
{
IV index = PTR2IV(o->op_ppaddr);
SV* keysv;
return SvPV_nolen(HeVAL(he));
}
-#endif
+
#include "XSUB.h"
/* Efficient sub that returns a constant scalar value. */
static void
-const_sv_xsub(pTHXo_ CV* cv)
+const_sv_xsub(pTHX_ CV* cv)
{
dXSARGS;
if (items != 0) {
projects / p5sagit/p5-mst-13.2.git / blobdiff