X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=4d694cdfcb51e98a9834d13b943833071e1b8aaf;hb=96a925ab0077cdd24bd7d328f20be3d5373d4885;hp=74499ab910b68ffe7dd37efeaae650046c4d7849;hpb=a55b55d8bdced7506ebb58e07395cd3123a8d718;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/toke.c b/toke.c
index 74499ab..4d694cd 100644
--- a/toke.c
+++ b/toke.c
@@ -1,6 +1,7 @@
 /*    toke.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -2141,7 +2142,7 @@ S_find_in_my_stash(pTHX_ char *pkgname, I32 len)
 #ifdef DEBUGGING
     static char* exp_name[] =
 	{ "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
-	  "ATTRTERM", "TERMBLOCK"
+	  "ATTRTERM", "TERMBLOCK", "TERMORDORDOR"
 	};
 #endif
 
@@ -2939,8 +2940,6 @@ Perl_yylex(pTHX)
 	PL_tokenbuf[0] = '%';
 	s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, TRUE);
 	if (!PL_tokenbuf[1]) {
-	    if (s == PL_bufend)
-		yyerror("Final % should be \\% or %name");
 	    PREREF('%');
 	}
 	PL_pending_ident = '%';
@@ -3025,6 +3024,8 @@ Perl_yylex(pTHX)
 			CvLOCKED_on(PL_compcv);
 		    else if (!PL_in_my && len == 6 && strnEQ(s, "method", len))
 			CvMETHOD_on(PL_compcv);
+		    else if (!PL_in_my && len == 9 && strnEQ(s, "assertion", len))
+		        CvASSERTION_on(PL_compcv);
 #ifdef USE_ITHREADS
 		    else if (PL_in_my == KEY_our && len == 6 &&
 			     strnEQ(s, "unique", len))
@@ -3086,6 +3087,7 @@ Perl_yylex(pTHX)
 	    PL_oldbufptr = PL_oldoldbufptr;		/* allow print(STDOUT 123) */
 	else
 	    PL_expect = XTERM;
+	s = skipspace(s);
 	TOKEN('(');
     case ';':
 	CLINE;
@@ -3207,12 +3209,17 @@ Perl_yylex(pTHX)
 			    || ((*t == 'q' || *t == 'x') && ++t < PL_bufend
 				&& !isALNUM(*t))))
 		    {
+			/* skip q//-like construct */
 			char *tmps;
 			char open, close, term;
 			I32 brackets = 1;
 
 			while (t < PL_bufend && isSPACE(*t))
 			    t++;
+			/* check for q => */
+			if (t+1 < PL_bufend && t[0] == '=' && t[1] == '>') {
+			    OPERATOR(HASHBRACK);
+			}
 			term = *t;
 			open = term;
 			if (term && (tmps = strchr("([{< )]}> )]}>",term)))
@@ -3225,7 +3232,7 @@ Perl_yylex(pTHX)
 				else if (*t == open)
 				    break;
 			    }
-			else
+			else {
 			    for (t++; t < PL_bufend; t++) {
 				if (*t == '\\' && t+1 < PL_bufend)
 				    t++;
@@ -3234,8 +3241,13 @@ Perl_yylex(pTHX)
 				else if (*t == open)
 				    brackets++;
 			    }
+			}
+			t++;
 		    }
-		    t++;
+		    else
+			/* skip plain q word */
+			while (t < PL_bufend && isALNUM_lazy_if(t,UTF))
+			     t += UTF8SKIP(t);
 		}
 		else if (isALNUM_lazy_if(t,UTF)) {
 		    t += UTF8SKIP(t);
@@ -3561,8 +3573,6 @@ Perl_yylex(pTHX)
 	PL_tokenbuf[0] = '@';
 	s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE);
 	if (!PL_tokenbuf[1]) {
-	    if (s == PL_bufend)
-		yyerror("Final @ should be \\@ or @name");
 	    PREREF('@');
 	}
 	if (PL_lex_state == LEX_NORMAL)
@@ -4072,6 +4082,8 @@ Perl_yylex(pTHX)
 			    TERM(FUNC0SUB);
 			if (strEQ(proto, "$"))
 			    OPERATOR(UNIOPSUB);
+			while (*proto == ';')
+			    proto++;
 			if (*proto == '&' && *s == '{') {
 			    sv_setpv(PL_subname, PL_curstash ? 
 					"__ANON__" : "__ANON__::__ANON__");
@@ -4186,8 +4198,29 @@ Perl_yylex(pTHX)
 		}
 #endif
 #ifdef PERLIO_LAYERS
-		if (UTF && !IN_BYTES)
-		    PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, ":utf8");
+		if (!IN_BYTES) {
+		    if (UTF)
+			PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, ":utf8");
+		    else if (PL_encoding) {
+			SV *name;
+			dSP;
+			ENTER;
+			SAVETMPS;
+			PUSHMARK(sp);
+			EXTEND(SP, 1);
+			XPUSHs(PL_encoding);
+			PUTBACK;
+			call_method("name", G_SCALAR);
+			SPAGAIN;
+			name = POPs;
+			PUTBACK;
+			PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, 
+					    Perl_form(aTHX_ ":encoding(%"SVf")",
+						      name));
+			FREETMPS;
+			LEAVE;
+		    }
+		}
 #endif
 		PL_rsfp = Nullfp;
 	    }
@@ -6274,8 +6307,10 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
 	}
 	if (*s == '}') {
 	    s++;
-	    if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets)
+	    if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
 		PL_lex_state = LEX_INTERPEND;
+		PL_expect = XREF;
+	    }
 	    if (funny == '#')
 		funny = '@';
 	    if (PL_lex_state == LEX_NORMAL) {
@@ -6287,8 +6322,6 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
 			funny, dest, funny, dest);
 		}
 	    }
-	    if (PL_lex_inwhat == OP_STRINGIFY)
-		PL_expect = XREF;
 	}
 	else {
 	    s = bracket;		/* let the parser handle it */
@@ -6664,8 +6697,12 @@ retval:
 	Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
     }
     SvREFCNT_dec(herewas);
-    if (UTF && !IN_BYTES && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
-	SvUTF8_on(tmpstr);
+    if (!IN_BYTES) {
+	if (UTF && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
+	    SvUTF8_on(tmpstr);
+	else if (PL_encoding)
+	    sv_recode_to_utf8(tmpstr, PL_encoding);
+    }
     PL_lex_stuff = tmpstr;
     yylval.ival = op_type;
     return s;
@@ -7615,6 +7652,12 @@ S_scan_formline(pTHX_ register char *s)
 	}
 	else
 	    PL_lex_state = LEX_FORMLINE;
+	if (!IN_BYTES) {
+	    if (UTF && is_utf8_string((U8*)SvPVX(stuff), SvCUR(stuff)))
+		SvUTF8_on(stuff);
+	    else if (PL_encoding)
+		sv_recode_to_utf8(stuff, PL_encoding);
+	}
 	PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
 	force_next(THING);
 	PL_nextval[PL_nexttoke].ival = OP_FORMLINE;