It's an error if any component of \p{user-defined} fails

A user-defined property can expand to more than one component that are
combined into a single result.  Prior to this commit, since the move of
this into core C, it was possible that if any component was valid, the
whole thing was considered valid, though in many instances an assertion
failed on DEBUGGING builds.

diff --git a/regcomp.c b/regcomp.c
index 0d4789b..aff83ef 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -22216,7 +22216,7 @@ Perl_handle_user_defined_property(pTHX_
                 Perl_sv_catpvf(aTHX_ msg, "%" UTF8f,
                                      UTF8fARG(is_contents_utf8, s - s0, s0));
                 sv_catpvs(msg, "\"");
-                goto return_msg;
+                goto return_failure;
             }
 
             /* Accumulate this digit into the value */
@@ -22251,7 +22251,7 @@ Perl_handle_user_defined_property(pTHX_
                     Perl_sv_catpvf(aTHX_ msg, "%" UTF8f,
                                       UTF8fARG(is_contents_utf8, s - s0, s0));
                     sv_catpvs(msg, "\"");
-                    goto return_msg;
+                    goto return_failure;
                 }
 
                 max = (max << 4) + READ_XDIGIT(s);
@@ -22279,7 +22279,7 @@ Perl_handle_user_defined_property(pTHX_
             Perl_sv_catpvf(aTHX_ msg, "%" UTF8f,
                                 UTF8fARG(is_contents_utf8, s - s0, s0));
             sv_catpvs(msg, "\"");
-            goto return_msg;
+            goto return_failure;
         }
 
 #if 0   /* See explanation at definition above of get_extended_utf8_msg() */
@@ -22334,8 +22334,8 @@ Perl_handle_user_defined_property(pTHX_
                                                 : level + 1
                                               );
         if (this_definition == NULL) {
-            goto return_msg;    /* 'msg' should have had the reason appended to
-                                   it by the above call */
+            goto return_failure;    /* 'msg' should have had the reason
+                                       appended to it by the above call */
         }
 
         if (! is_invlist(this_definition)) {    /* Unknown at this time */
@@ -22392,6 +22392,10 @@ Perl_handle_user_defined_property(pTHX_
     }
 
     /* Otherwise, add some explanatory text, but we will return success */
+    goto return_msg;
+
+  return_failure:
+    running_definition = NULL;
 
   return_msg:
 

diff --git a/t/re/regexp_unicode_prop.t b/t/re/regexp_unicode_prop.t
index ab117d2..6df2968 100644 (file)
--- a/t/re/regexp_unicode_prop.t
+++ b/t/re/regexp_unicode_prop.t
@@ -266,6 +266,7 @@ $count += 4 * grep {length $_ == 1} @ILLEGAL_PROPERTIES;
 $count += 8 * @USER_CASELESS_PROPERTIES;
 $count += 1 * (@DEFERRED - @USER_ERROR_PROPERTIES) / 2;
 $count += 1 * @USER_ERROR_PROPERTIES;
+$count += 1;    # one bad apple
 $count += 1;    # No warnings generated
 
 plan(tests => $count);
@@ -534,6 +535,12 @@ sub IsOverflow {
     return "0\t$overflow$utf8_comment";
 }
 
+fresh_perl_like(<<'EOP', qr/Can't find Unicode property definition "F000\\tF010" in expansion of InOneBadApple/, {}, "Just one component bad");
+# Extra backslash converts tab to backslash-t
+sub InOneBadApple { return "0100\t0110\n10000\t10010\nF000\\tF010\n0400\t0410" }
+qr/\p{InOneBadApple}/;
+EOP
+
 if (! is(@warnings, 0, "No warnings were generated")) {
     diag join "\n", @warnings, "\n";
 }