X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=de163fb5de960e68be78b2514be1c81bb823cd1e;hb=338584c0b1c948a967b5e2ecbb69c512410589e4;hp=a15dca6174c014034bbea2deb3034f36b18f0231;hpb=d85f917eae8ded4d020f0addd35e5aa488f2c0c0;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/toke.c b/toke.c
index a15dca6..de163fb 100644
--- a/toke.c
+++ b/toke.c
@@ -1384,7 +1384,9 @@ S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
 {
     dVAR;
     SV * const sv = newSVpvn_utf8(start, len,
-				  UTF && !IN_BYTES
+				  !IN_BYTES
+				  && UTF
+				  && !is_ascii_string((const U8*)start, len)
 				  && is_utf8_string((const U8*)start, len));
     return sv;
 }
@@ -2824,7 +2826,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
       bare_package:
 	    start_force(PL_curforce);
 	    NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0,
-						   newSVpvn(tmpbuf,len));
+						  S_newSV_maybe_utf8(aTHX_ tmpbuf, len));
 	    NEXTVAL_NEXTTOKE.opval->op_private = OPpCONST_BARE;
 	    if (PL_madskills)
 		curmad('X', newSVpvn(start,SvPVX(PL_linestr) + soff - start));
@@ -3999,7 +4001,14 @@ Perl_yylex(pTHX)
 			const char *d1 = d;
 
 			do {
-			    if (*d1 == 'M' || *d1 == 'm' || *d1 == 'C') {
+			    bool baduni = FALSE;
+			    if (*d1 == 'C') {
+				const char *d2 = d1 + 1;
+				if (parse_unicode_opts((const char **)&d2)
+				    != PL_unicode)
+				    baduni = TRUE;
+			    }
+			    if (baduni || *d1 == 'M' || *d1 == 'm') {
 				const char * const m = d1;
 				while (*d1 && !isSPACE(*d1))
 				    d1++;
@@ -4805,10 +4814,6 @@ Perl_yylex(pTHX)
 	pl_yylval.ival = 0;
 	OPERATOR(ASSIGNOP);
     case '!':
-	if (PL_expect == XSTATE && s[1] == '!' && s[2] == '!') {
-	    s += 3;
-	    LOP(OP_DIE,XTERM);
-	}
 	s++;
 	{
 	    const char tmp = *s++;
@@ -5060,10 +5065,6 @@ Perl_yylex(pTHX)
 	    AOPERATOR(DORDOR);
 	}
      case '?':			/* may either be conditional or pattern */
-	if (PL_expect == XSTATE && s[1] == '?' && s[2] == '?') {
-	    s += 3;
-	    LOP(OP_WARN,XTERM);
-	}
 	if (PL_expect == XOPERATOR) {
 	     char tmp = *s++;
 	     if(tmp == '?') {
@@ -5279,14 +5280,17 @@ Perl_yylex(pTHX)
 	/* Is this a label? */
 	if (!tmp && PL_expect == XSTATE
 	      && d < PL_bufend && *d == ':' && *(d + 1) != ':') {
+	    tmp = keyword(PL_tokenbuf, len, 0);
+	    if (tmp)
+		Perl_croak(aTHX_ "Can't use keyword '%s' as a label", PL_tokenbuf);
 	    s = d + 1;
 	    pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
 	    CLINE;
 	    TOKEN(LABEL);
 	}
-
-	/* Check for keywords */
-	tmp = keyword(PL_tokenbuf, len, 0);
+	else
+	    /* Check for keywords */
+	    tmp = keyword(PL_tokenbuf, len, 0);
 
 	/* Is this a word before a => operator? */
 	if (*d == '=' && d[1] == '>') {
@@ -5697,10 +5701,22 @@ Perl_yylex(pTHX)
 
 		/* Call it a bare word */
 
-		bareword:
 		if (PL_hints & HINT_STRICT_SUBS)
 		    pl_yylval.opval->op_private |= OPpCONST_STRICT;
 		else {
+		bareword:
+		    /* after "print" and similar functions (corresponding to
+		     * "F? L" in opcode.pl), whatever wasn't already parsed as
+		     * a filehandle should be subject to "strict subs".
+		     * Likewise for the optional indirect-object argument to system
+		     * or exec, which can't be a bareword */
+		    if ((PL_last_lop_op == OP_PRINT
+			    || PL_last_lop_op == OP_PRTF
+			    || PL_last_lop_op == OP_SAY
+			    || PL_last_lop_op == OP_SYSTEM
+			    || PL_last_lop_op == OP_EXEC)
+			    && (PL_hints & HINT_STRICT_SUBS))
+			pl_yylval.opval->op_private |= OPpCONST_STRICT;
 		    if (lastchar != '-') {
 			if (ckWARN(WARN_RESERVED)) {
 			    d = PL_tokenbuf;