Allow -C on the #! line when it is identical to -C on the command line.

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index c803a80..56e9620 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -124,6 +124,9 @@ static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
 #   define UTF ((PL_linestr && DO_UTF8(PL_linestr)) || (PL_hints & HINT_UTF8))
 #endif
 
+/* The maximum number of characters preceding the unrecognized one to display */
+#define UNRECOGNIZED_PRECEDE_COUNT 10
+
 /* In variables named $^X, these are the legal values for X.
  * 1999-02-27 mjd-perl-patch@plover.com */
 #define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
@@ -3652,8 +3655,17 @@ Perl_yylex(pTHX)
     default:
        if (isIDFIRST_lazy_if(s,UTF))
            goto keylookup;
-       len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
-       Perl_croak(aTHX_ "Unrecognized character \\x%02X in column %d", *s & 255, (int) len + 1);
+       {
+        unsigned char c = *s;
+        len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
+        if (len > UNRECOGNIZED_PRECEDE_COUNT) {
+            d = UTF ? (char *) Perl_utf8_hop(aTHX_ (U8 *) s, -UNRECOGNIZED_PRECEDE_COUNT) : s - UNRECOGNIZED_PRECEDE_COUNT;
+        } else {
+            d = PL_linestart;
+        }      
+        *s = '\0';
+        Perl_croak(aTHX_ "Unrecognized character \\x%02X; marked by <-- HERE after %s<-- HERE near column %d", c, d, (int) len + 1);
+    }
     case 4:
     case 26:
        goto fake_eof;                  /* emulate EOF on ^D or ^Z */
@@ -3958,7 +3970,7 @@ Perl_yylex(pTHX)
                    while (s < PL_bufend && isSPACE(*s))
                        s++;
                    if (s < PL_bufend) {
-                       Newxz(newargv,PL_origargc+3,char*);
+                       Newx(newargv,PL_origargc+3,char*);
                        newargv[1] = s;
                        while (s < PL_bufend && !isSPACE(*s))
                            s++;
@@ -3987,7 +3999,15 @@ 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;
+                               d2++;
+                               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++;
@@ -4793,10 +4813,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++;
@@ -5048,10 +5064,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 == '?') {