Skip to content

Commit 6256cf2

Browse files
committed
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.
1 parent aa6e6d2 commit 6256cf2

File tree

2 files changed

+16
-5
lines changed

2 files changed

+16
-5
lines changed

regcomp.c

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -22216,7 +22216,7 @@ Perl_handle_user_defined_property(pTHX_
2221622216
Perl_sv_catpvf(aTHX_ msg, "%" UTF8f,
2221722217
UTF8fARG(is_contents_utf8, s - s0, s0));
2221822218
sv_catpvs(msg, "\"");
22219-
goto return_msg;
22219+
goto return_failure;
2222022220
}
2222122221

2222222222
/* Accumulate this digit into the value */
@@ -22251,7 +22251,7 @@ Perl_handle_user_defined_property(pTHX_
2225122251
Perl_sv_catpvf(aTHX_ msg, "%" UTF8f,
2225222252
UTF8fARG(is_contents_utf8, s - s0, s0));
2225322253
sv_catpvs(msg, "\"");
22254-
goto return_msg;
22254+
goto return_failure;
2225522255
}
2225622256

2225722257
max = (max << 4) + READ_XDIGIT(s);
@@ -22279,7 +22279,7 @@ Perl_handle_user_defined_property(pTHX_
2227922279
Perl_sv_catpvf(aTHX_ msg, "%" UTF8f,
2228022280
UTF8fARG(is_contents_utf8, s - s0, s0));
2228122281
sv_catpvs(msg, "\"");
22282-
goto return_msg;
22282+
goto return_failure;
2228322283
}
2228422284

2228522285
#if 0 /* See explanation at definition above of get_extended_utf8_msg() */
@@ -22334,8 +22334,8 @@ Perl_handle_user_defined_property(pTHX_
2233422334
: level + 1
2233522335
);
2233622336
if (this_definition == NULL) {
22337-
goto return_msg; /* 'msg' should have had the reason appended to
22338-
it by the above call */
22337+
goto return_failure; /* 'msg' should have had the reason
22338+
appended to it by the above call */
2233922339
}
2234022340

2234122341
if (! is_invlist(this_definition)) { /* Unknown at this time */
@@ -22392,6 +22392,10 @@ Perl_handle_user_defined_property(pTHX_
2239222392
}
2239322393

2239422394
/* Otherwise, add some explanatory text, but we will return success */
22395+
goto return_msg;
22396+
22397+
return_failure:
22398+
running_definition = NULL;
2239522399

2239622400
return_msg:
2239722401

t/re/regexp_unicode_prop.t

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -266,6 +266,7 @@ $count += 4 * grep {length $_ == 1} @ILLEGAL_PROPERTIES;
266266
$count += 8 * @USER_CASELESS_PROPERTIES;
267267
$count += 1 * (@DEFERRED - @USER_ERROR_PROPERTIES) / 2;
268268
$count += 1 * @USER_ERROR_PROPERTIES;
269+
$count += 1; # one bad apple
269270
$count += 1; # No warnings generated
270271

271272
plan(tests => $count);
@@ -534,6 +535,12 @@ sub IsOverflow {
534535
return "0\t$overflow$utf8_comment";
535536
}
536537

538+
fresh_perl_like(<<'EOP', qr/Can't find Unicode property definition "F000\\tF010" in expansion of InOneBadApple/, {}, "Just one component bad");
539+
# Extra backslash converts tab to backslash-t
540+
sub InOneBadApple { return "0100\t0110\n10000\t10010\nF000\\tF010\n0400\t0410" }
541+
qr/\p{InOneBadApple}/;
542+
EOP
543+
537544
if (! is(@warnings, 0, "No warnings were generated")) {
538545
diag join "\n", @warnings, "\n";
539546
}

0 commit comments

Comments
 (0)