X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=bfc6436640c89580f26b8653c475f9ebeb9c6854;hb=70de81dbcb37565d53053ba5e4bc3a467e7b130b;hp=cf04cfa68e49b426dacc9f332fe94761addbf853;hpb=eb160463266f58ba83ae9bb9ae8bbdc8f0c3027b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/toke.c b/toke.c
index cf04cfa..bfc6436 100644
--- a/toke.c
+++ b/toke.c
@@ -41,11 +41,7 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
 #ifdef USE_UTF8_SCRIPTS
 #   define UTF (!IN_BYTES)
 #else
-#   ifdef EBCDIC /* For now 'use utf8' does not affect tokenizer on EBCDIC */
-#       define UTF (PL_linestr && DO_UTF8(PL_linestr))
-#   else
-#       define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
-#   endif
+#   define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
 #endif
 
 /* In variables named $^X, these are the legal values for X.
@@ -454,7 +450,7 @@ Perl_lex_start(pTHX_ SV *line)
     if (SvREADONLY(PL_linestr))
 	PL_linestr = sv_2mortal(newSVsv(PL_linestr));
     s = SvPV(PL_linestr, len);
-    if (len && s[len-1] != ';') {
+    if (!len || s[len-1] != ';') {
 	if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
 	    PL_linestr = sv_2mortal(newSVsv(PL_linestr));
 	sv_catpvn(PL_linestr, "\n;", 2);
@@ -1540,6 +1536,16 @@ S_scan_const(pTHX_ char *start)
 			e = s - 1;
 			goto cont_scan;
 		    }
+		    if (e > s + 2 && s[1] == 'U' && s[2] == '+') {
+		        /* \N{U+...} */
+		        I32 flags = PERL_SCAN_ALLOW_UNDERSCORES |
+			  PERL_SCAN_DISALLOW_PREFIX;
+		        s += 3;
+			len = e - s;
+			uv = grok_hex(s, &len, &flags, NULL);
+			s = e + 1;
+			goto NUM_ESCAPE_INSERT;
+		    }
 		    res = newSVpvn(s + 1, e - s - 1);
 		    res = new_constant( Nullch, 0, "charnames",
 					res, Nullsv, "\\N{...}" );
@@ -1864,7 +1870,7 @@ S_intuit_more(pTHX_ register char *s)
  * Method if it's "foo $bar"
  * Not a method if it's really "print foo $bar"
  * Method if it's really "foo package::" (interpreted as package->foo)
- * Not a method if bar is known to be a subroutne ("sub bar; foo bar")
+ * Not a method if bar is known to be a subroutine ("sub bar; foo bar")
  * Not a method if bar is a filehandle or package, but is quoted with
  *   =>
  */
@@ -2608,6 +2614,19 @@ Perl_yylex(pTHX)
 			sv_setpvn(x, ipath, ipathend - ipath);
 			SvSETMAGIC(x);
 		    }
+		    else {
+			STRLEN blen;
+			STRLEN llen;
+			char *bstart = SvPV(CopFILESV(PL_curcop),blen);
+			char *lstart = SvPV(x,llen);
+			if (llen < blen) {
+			    bstart += blen - llen;
+			    if (strnEQ(bstart, lstart, llen) &&	bstart[-1] == '/') {
+				sv_setpvn(x, ipath, ipathend - ipath);
+				SvSETMAGIC(x);
+			    }
+			}
+		    }
 		    TAINT_NOT;	/* $^X is always tainted, but that's OK */
 		}
 #endif /* ARG_ZERO_IS_SCRIPT */
@@ -3907,6 +3926,10 @@ Perl_yylex(pTHX)
 		CLINE;
 		yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
 		yylval.opval->op_private = OPpCONST_BARE;
+		/* UTF-8 package name? */
+		if (UTF && !IN_BYTES &&
+		    is_utf8_string((U8*)SvPVX(sv), SvCUR(sv)))
+		    SvUTF8_on(sv);
 
 		/* And if "Foo::", then that's what it certainly is. */
 
@@ -4041,7 +4064,7 @@ Perl_yylex(pTHX)
 		    if (ckWARN(WARN_RESERVED)) {
 			if (lastchar != '-') {
 			    for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
-			    if (!*d && strNE(PL_tokenbuf,"main"))
+			    if (!*d && !gv_stashpv(PL_tokenbuf,FALSE))
 				Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
 				       PL_tokenbuf);
 			}
@@ -6247,7 +6270,7 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des
 }
 
 void
-Perl_pmflag(pTHX_ U16 *pmfl, int ch)
+Perl_pmflag(pTHX_ U32* pmfl, int ch)
 {
     if (ch == 'i')
 	*pmfl |= PMf_FOLD;
@@ -7571,15 +7594,33 @@ Perl_yyerror(pTHX_ char *s)
 	where = "at EOF";
     else if (PL_bufptr > PL_oldoldbufptr && PL_bufptr - PL_oldoldbufptr < 200 &&
       PL_oldoldbufptr != PL_oldbufptr && PL_oldbufptr != PL_bufptr) {
+	/*
+		Only for NetWare:
+		The code below is removed for NetWare because it abends/crashes on NetWare
+		when the script has error such as not having the closing quotes like:
+		    if ($var eq "value)
+		Checking of white spaces is anyway done in NetWare code.
+	*/
+#ifndef NETWARE
 	while (isSPACE(*PL_oldoldbufptr))
 	    PL_oldoldbufptr++;
+#endif
 	context = PL_oldoldbufptr;
 	contlen = PL_bufptr - PL_oldoldbufptr;
     }
     else if (PL_bufptr > PL_oldbufptr && PL_bufptr - PL_oldbufptr < 200 &&
       PL_oldbufptr != PL_bufptr) {
+	/*
+		Only for NetWare:
+		The code below is removed for NetWare because it abends/crashes on NetWare
+		when the script has error such as not having the closing quotes like:
+		    if ($var eq "value)
+		Checking of white spaces is anyway done in NetWare code.
+	*/
+#ifndef NETWARE
 	while (isSPACE(*PL_oldbufptr))
 	    PL_oldbufptr++;
+#endif
 	context = PL_oldbufptr;
 	contlen = PL_bufptr - PL_oldbufptr;
     }