Reduce env var calls to one in ExtUtils::Install

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 2d4064f..692ab11 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -869,7 +869,7 @@ through normal scalar means.
 
 Direct pointer to the end of the chunk of text currently being lexed, the
 end of the lexer buffer.  This is equal to C<SvPVX(PL_parser-E<gt>linestr)
-+ SvCUR(PL_parser-E<gt>linestr)>.  A NUL character (zero octet) is
++ SvCUR(PL_parser-E<gt>linestr)>.  A C<NUL> character (zero octet) is
 always located at the end of the buffer, and does not count as part of
 the buffer's contents.
 
@@ -936,7 +936,7 @@ Perl_lex_bufutf8(pTHX)
 =for apidoc Amx|char *|lex_grow_linestr|STRLEN len
 
 Reallocates the lexer buffer (L</PL_parser-E<gt>linestr>) to accommodate
-at least I<len> octets (including terminating NUL).  Returns a
+at least I<len> octets (including terminating C<NUL>).  Returns a
 pointer to the reallocated buffer.  This is necessary before making
 any direct modification of the buffer that would increase its length.
 L</lex_stuff_pvn> provides a more convenient way to insert text into
@@ -2865,8 +2865,9 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
      * look to see that the first character is legal.  Then loop through the
      * rest checking that each is a continuation */
 
-    /* This code needs to be sync'ed with a regex in _charnames.pm which does
-     * the same thing */
+    /* This code makes the reasonable assumption that the only Latin1-range
+     * characters that begin a character name alias are alphabetic, otherwise
+     * would have to create a isCHARNAME_BEGIN macro */
 
     if (! UTF) {
         if (! isALPHAU(*s)) {
@@ -2877,18 +2878,16 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
             if (! isCHARNAME_CONT(*s)) {
                 goto bad_charname;
             }
-           if (*s == ' ' && *(s-1) == ' ' && ckWARN_d(WARN_DEPRECATED)) {
+           if (*s == ' ' && *(s-1) == ' ') {
+                goto multi_spaces;
+            }
+           if ((U8) *s == NBSP_NATIVE && ckWARN_d(WARN_DEPRECATED)) {
                 Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-                           "A sequence of multiple spaces in a charnames "
+                           "NO-BREAK SPACE in a charnames "
                            "alias definition is deprecated");
             }
             s++;
         }
-        if (*(s-1) == ' ' && ckWARN_d(WARN_DEPRECATED)) {
-            Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-                        "Trailing white-space in a charnames alias "
-                        "definition is deprecated");
-        }
     }
     else {
         /* Similarly for utf8.  For invariants can check directly; for other
@@ -2924,11 +2923,8 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
                 if (! isCHARNAME_CONT(*s)) {
                     goto bad_charname;
                 }
-                if (*s == ' ' && *(s-1) == ' '
-                 && ckWARN_d(WARN_DEPRECATED)) {
-                    Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-                               "A sequence of multiple spaces in a charnam"
-                               "es alias definition is deprecated");
+                if (*s == ' ' && *(s-1) == ' ') {
+                    goto multi_spaces;
                 }
                 s++;
             }
@@ -2937,6 +2933,14 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
                 {
                     goto bad_charname;
                 }
+                if (*s == *NBSP_UTF8
+                    && *(s+1) == *(NBSP_UTF8+1)
+                    && ckWARN_d(WARN_DEPRECATED))
+                {
+                    Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
+                                "NO-BREAK SPACE in a charnames "
+                                "alias definition is deprecated");
+                }
                 s += 2;
             }
             else {
@@ -2953,11 +2957,17 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
                 s += UTF8SKIP(s);
             }
         }
-        if (*(s-1) == ' ' && ckWARN_d(WARN_DEPRECATED)) {
-            Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
-                       "Trailing white-space in a charnames alias "
-                       "definition is deprecated");
-        }
+    }
+    if (*(s-1) == ' ') {
+        yyerror_pv(
+            Perl_form(aTHX_
+            "charnames alias definitions may not contain trailing "
+            "white-space; marked by <-- HERE in %.*s<-- HERE %.*s",
+            (int)(s - backslash_ptr + 1), backslash_ptr,
+            (int)(e - s + 1), s + 1
+            ),
+        UTF ? SVf_UTF8 : 0);
+        return NULL;
     }
 
     if (SvUTF8(res)) { /* Don't accept malformed input */
@@ -2988,19 +2998,29 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e)
     return res;
 
   bad_charname: {
-        int bad_char_size = ((UTF) ? UTF8SKIP(s) : 1);
 
         /* The final %.*s makes sure that should the trailing NUL be missing
          * that this print won't run off the end of the string */
         yyerror_pv(
           Perl_form(aTHX_
             "Invalid character in \\N{...}; marked by <-- HERE in %.*s<-- HERE %.*s",
-            (int)(s - backslash_ptr + bad_char_size), backslash_ptr,
-            (int)(e - s + bad_char_size), s + bad_char_size
+            (int)(s - backslash_ptr + 1), backslash_ptr,
+            (int)(e - s + 1), s + 1
           ),
           UTF ? SVf_UTF8 : 0);
         return NULL;
     }
+
+  multi_spaces:
+        yyerror_pv(
+          Perl_form(aTHX_
+            "charnames alias definitions may not contain a sequence of "
+            "multiple spaces; marked by <-- HERE in %.*s<-- HERE %.*s",
+            (int)(s - backslash_ptr + 1), backslash_ptr,
+            (int)(e - s + 1), s + 1
+          ),
+          UTF ? SVf_UTF8 : 0);
+        return NULL;
 }
 
 /*
@@ -3759,6 +3779,10 @@ S_scan_const(pTHX_ char *start)
                            const STRLEN off = d - SvPVX_const(sv);
                            d = off + SvGROW(sv, off + len + (STRLEN)(send - s) + 1);
                        }
+                        if (! SvUTF8(res)) {    /* Make sure is \N{} return is UTF-8 */
+                            sv_utf8_upgrade(res);
+                            str = SvPV_const(res, len);
+                        }
                        Copy(str, d, len, char);
                        d += len;
                    }
@@ -8485,7 +8509,7 @@ Perl_yylex(pTHX)
                    gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf),
                                 GV_ADD | (UTF ? SVf_UTF8 : 0));
                else if (*s == '<')
-                   yyerror("<> should be quotes");
+                   yyerror("<> at require-statement should be quotes");
            }
            if (orig_keyword == KEY_require) {
                orig_keyword = 0;