X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=bcf4fb63ad362ce1d1ed7313fa7fdb1fb86ee46f;hb=1dd9311ab0a647f516752dd7368cf0b3f3ae13a4;hp=75adb1747de3952067f81da25a2f1340a0db3083;hpb=3549bba96de364b82f346b5405db53a54cdb8630;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 75adb17..bcf4fb6 100644 --- a/op.c +++ b/op.c @@ -194,7 +194,7 @@ Perl_allocmy(pTHX_ char *name) /* check for duplicate declaration */ pad_check_dup(name, - PL_in_my == KEY_our, + (bool)(PL_in_my == KEY_our), (PL_curstash ? PL_curstash : PL_defstash) ); @@ -1829,8 +1829,11 @@ Perl_newPROG(pTHX_ OP *o) CALL_PEEP(PL_eval_start); } else { - if (o->op_type == OP_STUB) + if (o->op_type == OP_STUB) { + PL_comppad_name = 0; + PL_compcv = 0; return; + } PL_main_root = scope(sawparens(scalarvoid(o))); PL_curcop = &PL_compiling; PL_main_start = LINKLIST(PL_main_root); @@ -2009,6 +2012,8 @@ Perl_gen_constant_list(pTHX_ register OP *o) o->op_type = OP_RV2AV; o->op_ppaddr = PL_ppaddr[OP_RV2AV]; + o->op_flags &= ~OPf_REF; /* treat \(1..2) like an ordinary list */ + o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */ o->op_seq = 0; /* needs to be revisited in peep() */ curop = ((UNOP*)o)->op_first; ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--)); @@ -2169,7 +2174,7 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) listop->op_last = pushop; } - return (OP*)listop; + return CHECKOP(type, listop); } OP * @@ -2292,13 +2297,13 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) U8* tend = t + tlen; U8* rend = r + rlen; STRLEN ulen; - U32 tfirst = 1; - U32 tlast = 0; - I32 tdiff; - U32 rfirst = 1; - U32 rlast = 0; - I32 rdiff; - I32 diff; + UV tfirst = 1; + UV tlast = 0; + IV tdiff; + UV rfirst = 1; + UV rlast = 0; + IV rdiff; + IV diff; I32 none = 0; U32 max = 0; I32 bits; @@ -2606,7 +2611,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags) PmopSTASH_set(pmop,PL_curstash); } - return (OP*)pmop; + return CHECKOP(type, pmop); } OP * @@ -2674,7 +2679,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) OP *curop; if (pm->op_pmflags & PMf_EVAL) { curop = 0; - if (CopLINE(PL_curcop) < PL_multi_end) + if (CopLINE(PL_curcop) < (line_t)PL_multi_end) CopLINE_set(PL_curcop, (line_t)PL_multi_end); } else if (repl->op_type == OP_CONST) @@ -2926,6 +2931,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) PL_hints |= HINT_BLOCK_SCOPE; PL_copline = NOLINE; PL_expect = XSTATE; + PL_cop_seqmax++; /* Purely for B::*'s benefit */ } /* @@ -3412,6 +3418,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) first->op_next = (OP*)logop; first->op_sibling = other; + CHECKOP(type,logop); + o = newUNOP(OP_NULL, 0, (OP*)logop); other->op_next = o; @@ -3456,6 +3464,8 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop) logop->op_other = LINKLIST(trueop); logop->op_next = LINKLIST(falseop); + CHECKOP(OP_COND_EXPR, /* that's logop->op_type */ + logop); /* establish postfix order */ start = LINKLIST(first); @@ -3742,7 +3752,7 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo assert(!loop->op_next); /* for my $x () sets OPpLVAL_INTRO; * for our $x () sets OPpOUR_INTRO; both only used by Deparse.pm */ - loop->op_private = iterpflags; + loop->op_private = (U8)iterpflags; #ifdef PL_OP_SLAB_ALLOC { LOOP *tmp; @@ -4676,9 +4686,10 @@ Perl_ck_bitop(pTHX_ OP *o) (op) == OP_NE || (op) == OP_I_NE || \ (op) == OP_NCMP || (op) == OP_I_NCMP) o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK); - if (o->op_type == OP_BIT_OR - || o->op_type == OP_BIT_AND - || o->op_type == OP_BIT_XOR) + if (!(o->op_flags & OPf_STACKED) /* Not an assignment */ + && (o->op_type == OP_BIT_OR + || o->op_type == OP_BIT_AND + || o->op_type == OP_BIT_XOR)) { OP * left = cBINOPo->op_first; OP * right = left->op_sibling; @@ -4699,8 +4710,9 @@ Perl_ck_bitop(pTHX_ OP *o) OP * Perl_ck_concat(pTHX_ OP *o) { - if (cUNOPo->op_first->op_type == OP_CONCAT) - o->op_flags |= OPf_STACKED; + OP *kid = cUNOPo->op_first; + if (kid->op_type == OP_CONCAT && !(kUNOP->op_first->op_flags & OPf_MOD)) + o->op_flags |= OPf_STACKED; return o; } @@ -6510,80 +6522,3 @@ const_sv_xsub(pTHX_ CV* cv) ST(0) = (SV*)XSANY.any_ptr; XSRETURN(1); } - -PerlIO* -Perl_my_tmpfp(pTHX) -{ - PerlIO *f = NULL; - int fd = -1; -#ifdef PERL_EXTERNAL_GLOB - /* File::Temp pulls in Fcntl, which may not be available with - * e.g. miniperl, use mkstemp() or stdio tmpfile() instead. */ -# if defined(WIN32) || !defined(HAS_MKSTEMP) - FILE *stdio = PerlSIO_tmpfile(); - - if (stdio) { - if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)), - &PerlIO_stdio, "w+", Nullsv))) { - PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio); - - if (s) - s->stdio = stdio; - } - } -# else /* !WIN32 && HAS_MKSTEMP */ - SV *sv = newSVpv("/tmp/PerlIO_XXXXXX", 0); - - if (sv) { - fd = mkstemp(SvPVX(sv)); - if (fd >= 0) { - f = PerlIO_fdopen(fd, "w+"); - if (f) { - PerlLIO_unlink(SvPVX(sv)); - SvREFCNT_dec(sv); - } - } - } -# endif /* WIN32 || !HAS_MKSTEMP */ -#else - /* We have internal glob, which probably also means that we - * can also use File::Temp (which uses Fcntl) with impunity. */ - GV *gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV); - - if (!gv) { - ENTER; - Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, - newSVpvn("File::Temp", 10), Nullsv, Nullsv, Nullsv); - gv = gv_fetchpv("File::Temp::tempfile", FALSE, SVt_PVCV); - GvIMPORTED_CV_on(gv); - LEAVE; - } - if (gv && GvCV(gv)) { - dSP; - ENTER; - SAVETMPS; - PUSHMARK(SP); - PUTBACK; - if (call_sv((SV*)GvCV(gv), G_SCALAR)) { - GV *gv = (GV*)SvRV(newSVsv(*PL_stack_sp--)); - - if (gv) { - IO *io = GvIO(gv); - - if (io) { - fd = PerlIO_fileno(IoIFP(io)); - if (fd >= 0) - f = PerlIO_fdopen(fd, "w+"); - } - } - } - SPAGAIN; - PUTBACK; - FREETMPS; - LEAVE; - } -#endif - - return f; -} -