X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=207e762b807391bc60488f17f350067f09757701;hb=9d43a7557743d779c74d69ffc6df7fc17711f3ec;hp=59643e78b121cc32e2bcc99211d7905d04368d23;hpb=2b9d42f0ba1bb562fe21327dc7948ab1a5397a19;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 59643e7..207e762 100644 --- a/op.c +++ b/op.c @@ -103,30 +103,6 @@ S_no_bareword_allowed(pTHX_ OP *o) SvPV_nolen(cSVOPo_sv))); } -STATIC U8* -S_trlist_upgrade(pTHX_ U8** sp, U8** ep) -{ - U8 *s = *sp; - U8 *e = *ep; - U8 *d; - - Newz(801, d, (e - s) * 2, U8); - *sp = d; - - while (s < e) { - if (NATIVE_IS_INVARIANT(*s) || NATIVE_TO_UTF(*s) == 0xff) - *d++ = *s++; - else { - U8 c = NATIVE_TO_ASCII(*s++); - *d++ = UTF8_EIGHT_BIT_HI(c); - *d++ = UTF8_EIGHT_BIT_LO(c); - } - } - *ep = d; - return *sp; -} - - /* "register" allocation */ PADOFFSET @@ -977,8 +953,6 @@ Perl_scalar(pTHX_ OP *o) switch (o->op_type) { case OP_REPEAT: - if (o->op_private & OPpREPEAT_DOLIST) - null(((LISTOP*)cBINOPo->op_first)->op_first); scalar(cBINOPo->op_first); break; case OP_OR: @@ -2680,6 +2654,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) I32 grows = 0; register short *tbl; + PL_hints |= HINT_BLOCK_SCOPE; complement = o->op_private & OPpTRANS_COMPLEMENT; del = o->op_private & OPpTRANS_DELETE; squash = o->op_private & OPpTRANS_SQUASH; @@ -2710,8 +2685,19 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) U32 final; I32 from_utf = o->op_private & OPpTRANS_FROM_UTF; I32 to_utf = o->op_private & OPpTRANS_TO_UTF; - U8* tsave = from_utf ? NULL : trlist_upgrade(&t, &tend); - U8* rsave = (to_utf || !rlen) ? NULL : trlist_upgrade(&r, &rend); + U8* tsave = NULL; + U8* rsave = NULL; + + if (!from_utf) { + STRLEN len = tlen; + tsave = t = bytes_to_utf8(t, &len); + tend = t + len; + } + if (!to_utf && rlen) { + STRLEN len = rlen; + rsave = r = bytes_to_utf8(r, &len); + rend = r + len; + } /* There are several snags with this code on EBCDIC: 1. 0xFF is a legal UTF-EBCDIC byte (there are no illegal bytes). @@ -3321,6 +3307,20 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) PL_expect = XSTATE; } +/* +=for apidoc load_module + +Loads the module whose name is pointed to by the string part of name. +Note that the actual module name, not its filename, should be given. +Eg, "Foo::Bar" instead of "Foo/Bar.pm". flags can be any of +PERL_LOADMOD_DENY, PERL_LOADMOD_NOIMPORT, or PERL_LOADMOD_IMPORT_OPS +(or 0 for no flags). ver, if specified, provides version semantics +similar to C. The optional trailing SV* +arguments can be used to specify arguments to the module's import() +method, similar to C. + +=cut */ + void Perl_load_module(pTHX_ U32 flags, SV *name, SV *ver, ...) { @@ -3616,7 +3616,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ]; } cop->op_flags = flags; - cop->op_private = (PL_hints & HINT_BYTE); + cop->op_private = (PL_hints & HINT_PRIVATE_MASK); #ifdef NATIVE_HINTS cop->op_private |= NATIVE_HINTS; #endif @@ -5694,6 +5694,12 @@ Perl_ck_fun(pTHX_ OP *o) list(kid); break; case OA_AVREF: + if ((type == OP_PUSH || type == OP_UNSHIFT) + && !kid->op_sibling && ckWARN(WARN_SYNTAX)) + Perl_warner(aTHX_ WARN_SYNTAX, + "Useless use of %s with no values", + PL_op_desc[type]); + if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { @@ -5857,11 +5863,15 @@ Perl_ck_glob(pTHX_ OP *o) #if !defined(PERL_EXTERNAL_GLOB) /* XXX this can be tightened up and made more failsafe. */ if (!gv) { + GV *glob_gv; ENTER; - Perl_load_module(aTHX_ 0, newSVpvn("File::Glob", 10), Nullsv, - /* null-terminated import list */ - newSVpvn(":globally", 9), Nullsv); + Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn("File::Glob", 10), Nullsv, + Nullsv, Nullsv); gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV); + glob_gv = gv_fetchpv("File::Glob::csh_glob", FALSE, SVt_PVCV); + GvCV(gv) = GvCV(glob_gv); + SvREFCNT_inc((SV*)GvCV(gv)); + GvIMPORTED_CV_on(gv); LEAVE; } #endif /* PERL_EXTERNAL_GLOB */ @@ -6809,7 +6819,7 @@ Perl_peep(pTHX_ register OP *o) pop->op_next->op_type == OP_AELEM && !(pop->op_next->op_private & (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) && - (i = SvIV(((SVOP*)pop)->op_sv) - PL_compiling.cop_arybase) + (i = SvIV(((SVOP*)pop)->op_sv) - PL_curcop->cop_arybase) <= 255 && i >= 0) { @@ -6856,6 +6866,7 @@ Perl_peep(pTHX_ register OP *o) break; case OP_ENTERLOOP: + case OP_ENTERITER: o->op_seq = PL_op_seqmax++; while (cLOOP->op_redoop->op_type == OP_NULL) cLOOP->op_redoop = cLOOP->op_redoop->op_next;