X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=10273a01115901057e55da0ea6945db3d4dfb8f3;hb=9bc5fa8de0e98ff1317c3fdc7e35f6e13be0ac35;hp=0ec3cf66ed7599bcae6e211ca103982b7ec56232;hpb=f0af216fc1cc450de0014850eae1a2893448510c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/toke.c b/toke.c
index 0ec3cf6..10273a0 100644
--- a/toke.c
+++ b/toke.c
@@ -1377,7 +1377,7 @@ S_scan_const(pTHX_ char *start)
 	    default:
 	        {
 		    dTHR;
-		    if (ckWARN(WARN_MISC) && isALPHA(*s))
+		    if (ckWARN(WARN_MISC) && isALNUM(*s))
 			Perl_warner(aTHX_ WARN_MISC, 
 			       "Unrecognized escape \\%c passed through",
 			       *s);
@@ -1389,6 +1389,7 @@ S_scan_const(pTHX_ char *start)
 	    /* \132 indicates an octal constant */
 	    case '0': case '1': case '2': case '3':
 	    case '4': case '5': case '6': case '7':
+		len = 0;	/* disallow underscores */
 		uv = (UV)scan_oct(s, 3, &len);
 		s += len;
 		goto NUM_ESCAPE_INSERT;
@@ -1402,10 +1403,12 @@ S_scan_const(pTHX_ char *start)
 			yyerror("Missing right brace on \\x{}");
 			e = s;
 		    }
+		    len = 1;		/* allow underscores */
                     uv = (UV)scan_hex(s + 1, e - s - 1, &len);
                     s = e + 1;
 		}
 		else {
+		    len = 0;		/* disallow underscores */
 		    uv = (UV)scan_hex(s, 2, &len);
 		    s += len;
 		}
@@ -1479,8 +1482,14 @@ S_scan_const(pTHX_ char *start)
 		    res = new_constant( Nullch, 0, "charnames", 
 					res, Nullsv, "\\N{...}" );
 		    str = SvPV(res,len);
-		    if (len > 1)
+		    if (!has_utf && SvUTF8(res)) {
+			char *ostart = SvPVX(sv);
+			SvCUR_set(sv, d - ostart);
+			SvPOK_on(sv);
+			sv_utf8_upgrade(sv);
+			d = SvPVX(sv) + SvCUR(sv);
 			has_utf = TRUE;
+		    }
 		    if (len > e - s + 4) {
 			char *odest = SvPVX(sv);
 
@@ -1504,7 +1513,8 @@ S_scan_const(pTHX_ char *start)
 		*d = *s++;
 		if (isLOWER(*d))
 		   *d = toUPPER(*d);
-		*d++ = toCTRL(*d); 
+		*d = toCTRL(*d); 
+		d++;
 #else
 		len = *s++;
 		*d++ = toCTRL(len);
@@ -2641,7 +2651,7 @@ Perl_yylex(pTHX)
 #ifdef PERL_STRICT_CR
 	Perl_warn(aTHX_ "Illegal character \\%03o (carriage return)", '\r');
 	Perl_croak(aTHX_ 
-      "(Maybe you didn't strip carriage returns after a network transfer?)\n");
+      "\t(Maybe you didn't strip carriage returns after a network transfer?)\n");
 #endif
     case ' ': case '\t': case '\f': case 013:
 	s++;
@@ -2649,6 +2659,11 @@ Perl_yylex(pTHX)
     case '#':
     case '\n':
 	if (PL_lex_state != LEX_NORMAL || (PL_in_eval && !PL_rsfp)) {
+	    if (*s == '#' && s == PL_linestart && PL_in_eval && !PL_rsfp) {
+		/* handle eval qq[#line 1 "foo"\n ...] */
+		CopLINE_dec(PL_curcop);
+		incline(s);
+	    }
 	    d = PL_bufend;
 	    while (s < d && *s != '\n')
 		s++;
@@ -3278,7 +3293,7 @@ Perl_yylex(pTHX)
 	/* This kludge not intended to be bulletproof. */
 	if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
 	    yylval.opval = newSVOP(OP_CONST, 0,
-				   newSViv((IV)PL_compiling.cop_arybase));
+				   newSViv(PL_compiling.cop_arybase));
 	    yylval.opval->op_private = OPpCONST_ARYBASE;
 	    TERM(THING);
 	}
@@ -3612,7 +3627,7 @@ Perl_yylex(pTHX)
 	tmp = keyword(PL_tokenbuf, len);
 
 	/* Is this a word before a => operator? */
-	if (strnEQ(d,"=>",2)) {
+	if (*d == '=' && d[1] == '>') {
 	    CLINE;
 	    yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
 	    yylval.opval->op_private = OPpCONST_BARE;
@@ -3767,10 +3782,18 @@ Perl_yylex(pTHX)
 		    }
 		}
 
-		/* If followed by a paren, it's certainly a subroutine. */
 
 		PL_expect = XOPERATOR;
 		s = skipspace(s);
+
+		/* Is this a word before a => operator? */
+		if (*s == '=' && s[1] == '>') {
+		    CLINE;
+		    sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf);
+		    TERM(WORD);
+		}
+
+		/* If followed by a paren, it's certainly a subroutine. */
 		if (*s == '(') {
 		    CLINE;
 		    if (gv && GvCVu(gv)) {
@@ -4489,7 +4512,7 @@ Perl_yylex(pTHX)
 			    for (; !isSPACE(*d) && len; --len, ++d) ;
 			}
 			words = append_elem(OP_LIST, words,
-					    newSVOP(OP_CONST, 0, newSVpvn(b, d-b)));
+					    newSVOP(OP_CONST, 0, tokeq(newSVpvn(b, d-b))));
 		    }
 		}
 		if (words) {