X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=7d28e36dd03ca6de76376fa71426975a1bb010fb;hb=6ec152c37130b7e4730fc56d5699a4b02f7c0f4a;hp=87ee1af9c294785be32b05bf5831baa7f8f7f9d4;hpb=f70490b90fda7b80a67f7838e5b73e11fb7e7204;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 87ee1af..7d28e36 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
@@ -1161,6 +1137,9 @@ Perl_scalarvoid(pTHX_ OP *o)
 	else {
 	    if (ckWARN(WARN_VOID)) {
 		useless = "a constant";
+		/* the constants 0 and 1 are permitted as they are
+		   conventionally used as dummies in constructs like
+		        1 while some_condition_with_side_effects;  */
 		if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
 		    useless = 0;
 		else if (SvPOK(sv)) {
@@ -2678,6 +2657,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;
@@ -2708,8 +2688,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).
@@ -3319,6 +3310,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<use Foo::Bar VERSION>.  The optional trailing SV*
+arguments can be used to specify arguments to the module's import()
+method, similar to C<use Foo::Bar VERSION LIST>.
+
+=cut */
+
 void
 Perl_load_module(pTHX_ U32 flags, SV *name, SV *ver, ...)
 {
@@ -3614,7 +3619,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
@@ -5692,6 +5697,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))
 		{
@@ -5855,11 +5866,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 */
@@ -6807,7 +6822,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)
 		{
@@ -6854,6 +6869,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;