Allow qr'\N{...}'
authorKarl Williamson <khw@cpan.org>
Thu, 14 Mar 2019 00:03:01 +0000 (18:03 -0600)
committerKarl Williamson <khw@cpan.org>
Thu, 14 Mar 2019 00:17:55 +0000 (18:17 -0600)
pod/perldelta.pod
pod/perldiag.pod
pod/perlrebackslash.pod
regcomp.c
t/re/pat.t
t/re/pat_advanced.t
t/re/pat_rt_report.t
t/re/re_tests
toke.c

index 7518690..06ae872 100644 (file)
@@ -43,6 +43,12 @@ the Unicode Consortium suggests.
 Most properties are supported, with the remainder planned for 5.32.
 Details are in L<perlunicode/Wildcards in Property Values>.
 
+=head2 qr'\N{name}' is now supported
+
+Previously it was an error to evaluate a named character C<\N{...}>
+within a single quoted regular expression pattern (whose evaluation is
+deferred from the normal place).  This restriction is now removed.
+
 =head2 Unicode 12.0 is supported
 
 For details, see L<https://www.unicode.org/versions/Unicode12.0.0/>.
index eb24f14..c1d776b 100644 (file)
@@ -4021,38 +4021,6 @@ C<\N{...}> is used as one of the end points of the range, such as in
 What is meant here is unclear, as the C<\N{...}> escape is a sequence
 of code points, so this is made an error.
 
-=item \N{NAME} must be resolved by the lexer in regex; marked by
-S<<-- HERE> in m/%s/
-
-(F) When compiling a regex pattern, an unresolved named character or
-sequence was encountered.  This can happen in any of several ways that
-bypass the lexer, such as using single-quotish context, or an extra
-backslash in double-quotish:
-
-    $re = '\N{SPACE}'; # Wrong!
-    $re = "\\N{SPACE}";        # Wrong!
-    /$re/;
-
-Instead, use double-quotes with a single backslash:
-
-    $re = "\N{SPACE}"; # ok
-    /$re/;
-
-The lexer can be bypassed as well by creating the pattern from smaller
-components:
-
-    $re = '\N';
-    /${re}{SPACE}/;    # Wrong!
-
-It's not a good idea to split a construct in the middle like this, and
-it doesn't work here.  Instead use the solution above.
-
-Finally, the message also can happen under the C</x> regex modifier when the
-C<\N> is separated by spaces from the C<{>, in which case, remove the spaces.
-
-    /\N {SPACE}/x;     # Wrong!
-    /\N{SPACE}/x;      # ok
-
 =item No %s allowed while running setuid
 
 (F) Certain operations are deemed to be too insecure for a setuid or
index 01226e6..cfd182a 100644 (file)
@@ -187,7 +187,14 @@ rarely see it written without the two leading zeros.  C<\N{U+0041}> means
 "A" even on EBCDIC machines (where the ordinal value of "A" is not 0x41).
 
 It is even possible to give your own names to characters and character
-sequences.  For details, see L<charnames>.
+sequences by using the L<charnames> module.  These custom names are
+lexically scoped, and so a given code point may have different names
+in different scopes.  The name used is what is in effect at the time the
+C<\N{}> is expanded.  For patterns in double-quotish context, that means
+at the time the pattern is parsed.  But for patterns that are delimitted
+by single quotes, the expansion is deferred until pattern compilation
+time, which may very well have a different C<charnames> translator in
+effect.
 
 (There is an expanded internal form that you may see in debug output:
 C<\N{U+I<code point>.I<code point>...}>.
index 8c47645..d7c3d46 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -193,6 +193,7 @@ struct RExC_state_t {
     scan_frame *frame_last;
     U32         frame_count;
     AV         *warn_text;
+    HV         *unlexed_names;
 #ifdef ADD_TO_REGEXEC
     char       *starttry;              /* -Dr: where regtry was called. */
 #define RExC_starttry  (pRExC_state->starttry)
@@ -280,6 +281,7 @@ struct RExC_state_t {
 #define RExC_warn_text (pRExC_state->warn_text)
 #define RExC_in_script_run      (pRExC_state->in_script_run)
 #define RExC_use_BRANCHJ        (pRExC_state->use_BRANCHJ)
+#define RExC_unlexed_names (pRExC_state->unlexed_names)
 
 /* Heuristic check on the complexity of the pattern: if TOO_NAUGHTY, we set
  * a flag to disable back-off on the fixed/floating substrings - if it's
@@ -7357,6 +7359,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count,
     }
 
     pRExC_state->warn_text = NULL;
+    pRExC_state->unlexed_names = NULL;
     pRExC_state->code_blocks = NULL;
 
     if (is_bare_re)
@@ -12610,7 +12613,7 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state,
   * points) that this \N sequence matches.  This is set, and the input is
   * parsed for errors, even if the function returns FALSE, as detailed below.
   *
-  * There are 5 possibilities here, as detailed in the next 5 paragraphs.
+  * There are 6 possibilities here, as detailed in the next 6 paragraphs.
   *
   * Probably the most common case is for the \N to specify a single code point.
   * *cp_count will be set to 1, and *code_point_p will be set to that code
@@ -12619,10 +12622,14 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state,
   * Another possibility is for the input to be an empty \N{}.  This is no
   * longer accepted, and will generate a fatal error.
   *
+  * Another possibility is for a custom charnames handler to be in effect which
+  * translates the input name to an empty string.  *cp_count will be set to 0.
+  * *node_p will be set to a generated NOTHING node.
+  *
   * Still another possibility is for the \N to mean [^\n]. *cp_count will be
   * set to 0. *node_p will be set to a generated REG_ANY node.
   *
-  * The fourth possibility is that \N resolves to a sequence of more than one
+  * The fifth possibility is that \N resolves to a sequence of more than one
   * code points.  *cp_count will be set to the number of code points in the
   * sequence. *node_p will be set to a generated node returned by this
   * function calling S_reg().
@@ -12630,7 +12637,7 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state,
   * The final possibility is that it is premature to be calling this function;
   * the parse needs to be restarted.  This can happen when this changes from
   * /d to /u rules, or when the pattern needs to be upgraded to UTF-8.  The
-  * latter occurs only when the fourth possibility would otherwise be in
+  * latter occurs only when the fifth possibility would otherwise be in
   * effect, and is because one of those code points requires the pattern to be
   * recompiled as UTF-8.  The function returns FALSE, and sets the
   * RESTART_PARSE and NEED_UTF8 flags in *flagp, as appropriate.  When this
@@ -12647,12 +12654,11 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state,
   * so we need a way to take a snapshot of what they resolve to at the time of
   * the original parse. [perl #56444].
   *
-  * That parsing is skipped for single-quoted regexes, so we may here get
-  * '\N{NAME}'.  This is a fatal error.  These names have to be resolved by the
-  * parser.  But if the single-quoted regex is something like '\N{U+41}', that
-  * is legal and handled here.  The code point is Unicode, and has to be
-  * translated into the native character set for non-ASCII platforms.
-  */
+  * That parsing is skipped for single-quoted regexes, so here we may get
+  * '\N{NAME}', which is parsed now.  If the single-quoted regex is something
+  * like '\N{U+41}', that code point is Unicode, and has to be translated into
+  * the native character set for non-ASCII platforms.  The other possibilities
+  * are already native, so no translation is done. */
 
     char * endbrace;    /* points to '}' following the name */
     char* p = RExC_parse; /* Temporary */
@@ -12660,8 +12666,8 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state,
     SV * substitute_parse = NULL;
     char *orig_end;
     char *save_start;
+    bool save_strict;
     I32 flags;
-    Size_t count = 0;   /* code point count kept internally by this function */
 
     GET_RE_DEBUG_FLAGS_DECL;
 
@@ -12721,7 +12727,10 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state,
      * imply Unicode semantics */
     REQUIRE_UNI_RULES(flagp, FALSE);
 
-    if (endbrace == RExC_parse) {   /* empty: \N{} */
+    /* \N{_} is what toke.c returns to us to indicate a name that evaluates to
+     * nothing at all (not allowed under strict) */
+    if (endbrace - RExC_parse == 1 && *RExC_parse == '_') {
+        RExC_parse = endbrace;
         if (strict) {
             RExC_parse++;   /* Position after the "}" */
             vFAIL("Zero length \\N{}");
@@ -12739,15 +12748,122 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state,
         return TRUE;
     }
 
-    /* If we haven't got something that begins with 'U+', then it didn't get lexed. */
-    if (   endbrace - RExC_parse < 2
-        || strnNE(RExC_parse, "U+", 2))
-    {
-        RExC_parse = endbrace;  /* position msg's '<--HERE' */
-        vFAIL("\\N{NAME} must be resolved by the lexer");
-    }
+    if (endbrace - RExC_parse < 2 || ! strBEGINs(RExC_parse, "U+")) {
+
+        /* Here, the name isn't of the form  U+....  This can happen if the
+         * pattern is single-quoted, so didn't get evaluated in toke.c.  Now
+         * is the time to find out what the name means */
+
+        const STRLEN name_len = endbrace - RExC_parse;
+        SV *  value_sv;     /* What does this name evaluate to */
+        SV ** value_svp;
+        const U8 * value;   /* string of name's value */
+        STRLEN value_len;   /* and its length */
+
+        /*  RExC_unlexed_names is a hash of names that weren't evaluated by
+         *  toke.c, and their values. Make sure is initialized */
+        if (! RExC_unlexed_names) {
+            RExC_unlexed_names = newHV();
+        }
+
+        /* If we have already seen this name in this pattern, use that.  This
+         * allows us to only call the charnames handler once per name per
+         * pattern.  A broken or malicious handler could return something
+         * different each time, which could cause the results to vary depending
+         * on if something gets added or subtracted from the pattern that
+         * causes the number of passes to change, for example */
+        if ((value_svp = hv_fetch(RExC_unlexed_names, RExC_parse,
+                                                      name_len, 0)))
+        {
+            value_sv = *value_svp;
+        }
+        else { /* Otherwise we have to go out and get the name */
+            const char * error_msg = NULL;
+            value_sv = get_and_check_backslash_N_name(RExC_parse, endbrace,
+                                                      UTF,
+                                                      &error_msg);
+            if (error_msg) {
+                RExC_parse = endbrace;
+                vFAIL(error_msg);
+            }
+
+            /* If no error message, should have gotten a valid return */
+            assert (value_sv);
+
+            /* Save the name's meaning for later use */
+            if (! hv_store(RExC_unlexed_names, RExC_parse, name_len,
+                           value_sv, 0))
+            {
+                Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed");
+            }
+        }
+
+        /* Here, we have the value the name evaluates to in 'value_sv' */
+        value = (U8 *) SvPV(value_sv, value_len);
+
+        /* See if the result is one code point vs 0 or multiple */
+        if (value_len > 0 && value_len <= ((SvUTF8(value_sv))
+                                           ? UTF8SKIP(value)
+                                           : 1))
+        {
+            /* Here, exactly one code point.  If that isn't what is wanted,
+             * fail */
+            if (! code_point_p) {
+                RExC_parse = p;
+                return FALSE;
+            }
 
-        /* This code purposely indented below because of future changes coming */
+            /* Convert from string to numeric code point */
+            *code_point_p = (SvUTF8(value_sv))
+                            ? valid_utf8_to_uvchr(value, NULL)
+                            : *value;
+
+            /* Have parsed this entire single code point \N{...}.  *cp_count
+             * has already been set to 1, so don't do it again. */
+            RExC_parse = endbrace;
+            nextchar(pRExC_state);
+            return TRUE;
+        } /* End of is a single code point */
+
+        /* Count the code points, if caller desires.  The API says to do this
+         * even if we will later return FALSE */
+        if (cp_count) {
+            *cp_count = 0;
+
+            *cp_count = (SvUTF8(value_sv))
+                        ? utf8_length(value, value + value_len)
+                        : value_len;
+        }
+
+        /* Fail if caller doesn't want to handle a multi-code-point sequence.
+         * But don't back the pointer up if the caller wants to know how many
+         * code points there are (they need to handle it themselves in this
+         * case).  */
+        if (! node_p) {
+            if (! cp_count) {
+                RExC_parse = p;
+            }
+            return FALSE;
+        }
+
+        /* Convert this to a sub-pattern of the form "(?: ... )", and then call
+         * reg recursively to parse it.  That way, it retains its atomicness,
+         * while not having to worry about any special handling that some code
+         * points may have. */
+
+        substitute_parse = newSVpvs("?:");
+        sv_catsv(substitute_parse, value_sv);
+        sv_catpv(substitute_parse, ")");
+
+#ifdef EBCDIC
+        /* The value should already be native, so no need to convert on EBCDIC
+         * platforms.*/
+        assert(! RExC_recode_x_to_native);
+#endif
+
+    }
+    else {   /* \N{U+...} */
+        Size_t count = 0;   /* code point count kept internally */
 
         /* We can get to here when the input is \N{U+...} or when toke.c has
          * converted a name to the \N{U+...} form.  This include changing a
@@ -12882,6 +12998,8 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state,
         RExC_recode_x_to_native = 1;
 #endif
 
+    }
+
     /* Here, we have the string the name evaluates to, ready to be parsed,
      * stored in 'substitute_parse' as a series of valid "\x{...}\x{...}"
      * constructs.  This can be called from within a substitute parse already.
index c3e4521..e6b4769 100644 (file)
@@ -23,7 +23,7 @@ BEGIN {
     skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
     skip_all_without_unicode_tables();
 
-plan tests => 853;  # Update this when adding/deleting tests.
+plan tests => 854;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1352,6 +1352,7 @@ EOP
         unlike "\x{100}", qr/(?i:\w)/, "(?i: shouldn't lose the passed in /a";
         use re '/aa';
         unlike 'k', qr/(?i:\N{KELVIN SIGN})/, "(?i: shouldn't lose the passed in /aa";
+        unlike 'k', qr'(?i:\N{KELVIN SIGN})', "(?i: shouldn't lose the passed in /aa";
     }
 
     {
index 77befc1..21a43b8 100644 (file)
@@ -534,28 +534,46 @@ sub run_tests {
 
         like("\N{LATIN SMALL LETTER SHARP S}",
             qr/\N{LATIN SMALL LETTER SHARP S}/, $message);
+        like("\N{LATIN SMALL LETTER SHARP S}",
+            qr'\N{LATIN SMALL LETTER SHARP S}', $message);
         like("\N{LATIN SMALL LETTER SHARP S}",
             qr/\N{LATIN SMALL LETTER SHARP S}/i, $message);
+        like("\N{LATIN SMALL LETTER SHARP S}",
+            qr'\N{LATIN SMALL LETTER SHARP S}'i, $message);
         like("\N{LATIN SMALL LETTER SHARP S}",
             qr/[\N{LATIN SMALL LETTER SHARP S}]/, $message);
+        like("\N{LATIN SMALL LETTER SHARP S}",
+            qr'[\N{LATIN SMALL LETTER SHARP S}]', $message);
         like("\N{LATIN SMALL LETTER SHARP S}",
             qr/[\N{LATIN SMALL LETTER SHARP S}]/i, $message);
+        like("\N{LATIN SMALL LETTER SHARP S}",
+            qr'[\N{LATIN SMALL LETTER SHARP S}]'i, $message);
 
         like("ss", qr /\N{LATIN SMALL LETTER SHARP S}/i, $message);
+        like("ss", qr '\N{LATIN SMALL LETTER SHARP S}'i, $message);
         like("SS", qr /\N{LATIN SMALL LETTER SHARP S}/i, $message);
+        like("SS", qr '\N{LATIN SMALL LETTER SHARP S}'i, $message);
         like("ss", qr/[\N{LATIN SMALL LETTER SHARP S}]/i, $message);
+        like("ss", qr'[\N{LATIN SMALL LETTER SHARP S}]'i, $message);
         like("SS", qr/[\N{LATIN SMALL LETTER SHARP S}]/i, $message);
+        like("SS", qr'[\N{LATIN SMALL LETTER SHARP S}]'i, $message);
 
         like("\N{LATIN SMALL LETTER SHARP S}", qr/ss/i, $message);
         like("\N{LATIN SMALL LETTER SHARP S}", qr/SS/i, $message);
 
          $message = "Unoptimized named sequence in class";
         like("ss", qr/[\N{LATIN SMALL LETTER SHARP S}x]/i, $message);
+        like("ss", qr'[\N{LATIN SMALL LETTER SHARP S}x]'i, $message);
         like("SS", qr/[\N{LATIN SMALL LETTER SHARP S}x]/i, $message);
+        like("SS", qr'[\N{LATIN SMALL LETTER SHARP S}x]'i, $message);
         like("\N{LATIN SMALL LETTER SHARP S}",
             qr/[\N{LATIN SMALL LETTER SHARP S}x]/, $message);
+        like("\N{LATIN SMALL LETTER SHARP S}",
+            qr'[\N{LATIN SMALL LETTER SHARP S}x]', $message);
         like("\N{LATIN SMALL LETTER SHARP S}",
             qr/[\N{LATIN SMALL LETTER SHARP S}x]/i, $message);
+        like("\N{LATIN SMALL LETTER SHARP S}",
+            qr'[\N{LATIN SMALL LETTER SHARP S}x]'i, $message);
     }
 
     {
@@ -825,6 +843,8 @@ sub run_tests {
             for my $tail ('\N{SNOWFLAKE}') {
                 eval qq {use charnames ':full';
                          like("$head$tail", qr/$head$tail/, \$message)};
+                eval qq {use charnames ':full';
+                         like("$head$tail", qr'$head$tail', \$message)};
                is($@, '', $message);
             }
         }
@@ -942,8 +962,12 @@ sub run_tests {
         # time: A AB ABC ABCD ...
         ok 'AB'  =~ /(\N{EVIL})/ && $1 eq 'A', 'Charname caching $1';
         like 'ABC', qr/(\N{EVIL})/,              'Charname caching $1';
+        ok 'ABCD'  =~ m'(\N{EVIL})' && $1 eq 'ABC', 'Charname caching $1';
+        ok 'ABCDE'  =~ m'(\N{EVIL})',          'Charname caching $1';
         like 'xy',  qr/x\N{EMPTY-STR}y/,
                     'Empty string charname produces NOTHING node';
+        ok 'xy'  =~ 'x\N{EMPTY-STR}y',
+                    'Empty string charname produces NOTHING node';
         like '', qr/\N{EMPTY-STR}/,
                     'Empty string charname produces NOTHING node';
         like "\N{LONG-STR}", qr/^\N{LONG-STR}$/, 'Verify that long string works';
@@ -951,9 +975,14 @@ sub run_tests {
 
         # perlhacktips points out that these work on both ASCII and EBCDIC
         like "\xfc", qr/\N{EMPTY-STR}\xdc/i, 'Empty \N{} should change /d to /u';
+        like "\xfc", qr'\N{EMPTY-STR}\xdc'i, 'Empty \N{} should change /d to /u';
 
         eval '/(?[[\N{EMPTY-STR}]])/';
         like $@, qr/Zero length \\N\{\}/, 'Verify zero-length return from \N{} correctly fails';
+        ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/, 'Verify that long string works';
+        ok "\N{LONG-STR}" =~ '^\N{LONG-STR}$', 'Verify that long string works';
+        ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/i, 'Verify under folding that long string works';
+        ok "\N{LONG-STR}" =~ m'^\N{LONG-STR}$'i, 'Verify under folding that long string works';
 
         undef $w;
         {
@@ -2436,6 +2465,7 @@ EOF
     {   # [perl #126606 crashed the interpreter
         use Cname;
         like("sS", qr/\N{EMPTY-STR}Ss|/i, '\N{} with empty branch alternation works');
+        like("sS", qr'\N{EMPTY-STR}Ss|'i, '\N{} with empty branch alternation works');
     }
 
     { # Regexp:Grammars was broken:
index dd740e7..de25900 100644 (file)
@@ -20,7 +20,7 @@ use warnings;
 use 5.010;
 use Config;
 
-plan tests => 2504;  # Update this when adding/deleting tests.
+plan tests => 2509;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1044,23 +1044,29 @@ sub run_tests {
         use charnames ":full";
         # Delayed interpolation of \N'
         my $r1 = qr/\N{THAI CHARACTER SARA I}/;
+        my $r2 = qr'\N{THAI CHARACTER SARA I}';
         my $s1 = "\x{E34}\x{E34}\x{E34}\x{E34}";
 
         # Bug #56444
         ok $s1 =~ /$r1+/, 'my $r1 = qr/\N{THAI CHARACTER SARA I}/; my $s1 = "\x{E34}\x{E34}\x{E34}\x{E34}; $s1 =~ /$r1+/';
+        ok $s1 =~ /$r2+/, 'my $r2 = qr\'\N{THAI CHARACTER SARA I}\'; my $s1 = "\x{E34}\x{E34}\x{E34}\x{E34}; $s1 =~ \'$r2+\'';
 
         # Bug #62056
         ok "${s1}A" =~ m/$s1\N{LATIN CAPITAL LETTER A}/, '"${s1}A" =~ m/$s1\N{LATIN CAPITAL LETTER A}/';
 
         ok "abbbbc" =~ m/\N{1}/ && $& eq "a", '"abbbbc" =~ m/\N{1}/ && $& eq "a"';
+        ok "abbbbc" =~ m'\N{1}' && $& eq "a", '"abbbbc" =~ m\'\N{1}\' && $& eq "a"';
         ok "abbbbc" =~ m/\N{3,4}/ && $& eq "abbb", '"abbbbc" =~ m/\N{3,4}/ && $& eq "abbb"';
+        ok "abbbbc" =~ m'\N{3,4}' && $& eq "abbb", '"abbbbc" =~ m\'\N{3,4}\' && $& eq "abbb"';
     }
 
     {
         use charnames ":full";
         my $message = '[perl #74982] Period coming after \N{}';
         ok("\x{ff08}." =~ m/\N{FULLWIDTH LEFT PARENTHESIS}./ && $& eq "\x{ff08}.", $message);
+        ok("\x{ff08}." =~ m'\N{FULLWIDTH LEFT PARENTHESIS}.' && $& eq "\x{ff08}.", $message);
         ok("\x{ff08}." =~ m/[\N{FULLWIDTH LEFT PARENTHESIS}]./ && $& eq "\x{ff08}.", $message);
+        ok("\x{ff08}." =~ m'[\N{FULLWIDTH LEFT PARENTHESIS}].' && $& eq "\x{ff08}.", $message);
     }
 
 SKIP: {
index a8b6748..9b615ea 100644 (file)
@@ -1446,7 +1446,9 @@ foo(\h)bar        foo\tbar        y       $1      \t
 
 # Verify that \N{U+...} forces Unicode rules
 /\N{U+41}\x{c1}/i      a\x{e1} y       $&      a\x{e1}
+'\N{U+41}\x{c1}'i      a\x{e1} y       $&      a\x{e1}
 /[\N{U+41}\x{c1}]/i    \x{e1}  y       $&      \x{e1}
+'[\N{U+41}\x{c1}]'i    \x{e1}  y       $&      \x{e1}
 '\N{U+41}'     A       y       $&      A               # Even for single quoted patterns
 
 [\s][\S]       \x{a0}\x{a0}    n       -       -       # Unicode complements should not match same character
@@ -1479,7 +1481,7 @@ abc\N     abc\n   n
 [\N{U+}]       -       c       -       Invalid hexadecimal number
 \N{U+4AG3}     -       c       -       Invalid hexadecimal number
 [\N{U+4AG3}]   -       c       -       Invalid hexadecimal number
-abc\N{def}     -       c       -       \\N{NAME} must be resolved by the lexer
+abc\N{def}     -       c       -       Unknown charname 'def' in regex
 abc\N{U+4AG3   -       c       -       Missing right brace on \\N{}
 abc\N{def      -       c       -       Missing right brace on \\N{}
 abc\N{ -       c       -       Missing right brace on \\N{}
@@ -1490,6 +1492,7 @@ abc\N{    -       c       -       Missing right brace on \\N{}
 
 # Verifies catches hex errors
 /\N{U+0xBEEF}/ -       c       -       Invalid hexadecimal number
+\N{U+0xBEEF}   -       c       -       Invalid hexadecimal number
 # Used to be an error, but not any more:
 /\N{U+BEEF.BEAD}/      -       c       -       
 
diff --git a/toke.c b/toke.c
index af3a5eb..f17bfe1 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3794,8 +3794,9 @@ S_scan_const(pTHX_ char *start)
                     if (PL_lex_inpat) {
 
                        if (! len) { /* The name resolved to an empty string */
-                           Copy("\\N{}", d, 4, char);
-                           d += 4;
+                            const char empty_N[] = "\\N{_}";
+                            Copy(empty_N, d, sizeof(empty_N) - 1, char);
+                            d += sizeof(empty_N) - 1;
                        }
                        else {
                            /* In order to not lose information for the regex