d = s;
dstart = d;
- while (s < send) {
- STRLEN len;
- const UV comp = utf8n_to_uvchr(s, send - s, &len,
- UTF8_ALLOW_DEFAULT);
- UV ch;
- short sch;
-
- sch = tbl->map[comp >= size ? size : comp];
-
- if (sch >= 0) {
- ch = (UV)sch;
- replace:
- matches++;
- if (LIKELY(!squash || ch != pch)) {
- d = uvchr_to_utf8(d, ch);
- pch = ch;
- }
- s += len;
- continue;
- }
- else if (sch == -1) { /* -1 is unmapped character */
- Move(s, d, len, U8);
- d += len;
- }
- else if (sch == -2) /* -2 is delete character */
- matches++;
- else {
- assert(sch == -3); /* -3 is empty replacement */
- ch = comp;
- goto replace;
+ while (s < send) {
+ STRLEN len;
+ const UV comp = utf8n_to_uvchr(s, send - s, &len,
+ UTF8_ALLOW_DEFAULT);
+ UV ch;
+ short sch;
+
+ sch = tbl->map[comp >= size ? size : comp];
+
+ if (sch >= 0) {
+ ch = (UV)sch;
+ replace:
+ matches++;
+ if (LIKELY(!squash || ch != pch)) {
+ d = uvchr_to_utf8(d, ch);
+ pch = ch;
}
-
- s += len;
- pch = 0xfeedface;
- }
+ s += len;
+ continue;
+ }
+ else if (sch == -1) { /* -1 is unmapped character */
+ Move(s, d, len, U8);
+ d += len;
+ }
+ else if (sch == -2) /* -2 is delete character */
+ matches++;
+ else {
+ assert(sch == -3); /* -3 is empty replacement */
+ ch = comp;
+ goto replace;
+ }
+
+ s += len;
+ pch = 0xfeedface;
+ }
if (grows) {
sv_setpvn(sv, (char*)dstart, d - dstart);
Perl_croak(aTHX_ "Illegal number of bits in vec");
if (SvUTF8(sv)) {
- if (Perl_sv_utf8_downgrade(aTHX_ sv, TRUE)) {
+ if (Perl_sv_utf8_downgrade_flags(aTHX_ sv, TRUE, 0)) {
/* PVX may have changed */
s = (unsigned char *) SvPV_flags(sv, srclen, svpv_flags);
}
else {
- Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- "Use of strings with code points over 0xFF as"
- " arguments to vec is deprecated. This will"
- " be a fatal error in Perl 5.32");
+ Perl_croak(aTHX_ "Use of strings with code points over 0xFF as arguments to vec is forbidden");
}
}
SV_GMAGIC | SV_UNDEF_RETURNS_NULL);
if (SvUTF8(targ)) {
/* This is handled by the SvPOK_only below...
- if (!Perl_sv_utf8_downgrade(aTHX_ targ, TRUE))
+ if (!Perl_sv_utf8_downgrade_flags(aTHX_ targ, TRUE, 0))
SvUTF8_off(targ);
*/
- (void) Perl_sv_utf8_downgrade(aTHX_ targ, TRUE);
+ (void) Perl_sv_utf8_downgrade_flags(aTHX_ targ, TRUE, 0);
}
(void)SvPOK_only(targ);
STRLEN rightlen;
const char *lc;
const char *rc;
- STRLEN len;
+ STRLEN len = 0;
STRLEN lensave;
const char *lsave;
const char *rsave;
* on zeros without having to do it. In the case of '&', the result is
* zero, and the dangling portion is simply discarded. For '|' and '^', the
* result is the same as the other operand, so the dangling part is just
- * appended to the final result, unchanged. We currently accept above-FF
- * code points in the dangling portion, as that's how it has long worked,
- * and code depends on it staying that way. But it is now fatal for
- * above-FF to appear in the portion that does get operated on. Hence, any
- * above-FF must come only in the longer operand, and only in its dangling
- * portion. That means that at least one of the operands has to be
- * entirely non-UTF-8, and the length of that operand has to be before the
- * first above-FF in the other */
+ * appended to the final result, unchanged. As of perl-5.32, we no longer
+ * accept above-FF code points in the dangling portion.
+ */
if (left_utf8 || right_utf8) {
- if (left_utf8) {
- if (right_utf8 || rightlen > leftlen) {
- Perl_croak(aTHX_ fatal_above_ff_msg, PL_op_desc[optype]);
- }
- len = rightlen;
- }
- else if (right_utf8) {
- if (leftlen > rightlen) {
- Perl_croak(aTHX_ fatal_above_ff_msg, PL_op_desc[optype]);
- }
- len = leftlen;
- }
-
- Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- deprecated_above_ff_msg, PL_op_desc[optype]);
+ Perl_croak(aTHX_ FATAL_ABOVE_FF_MSG, PL_op_desc[optype]);
}
else { /* Neither is UTF-8 */
len = MIN(leftlen, rightlen);
len = lensave;
if (rightlen > len) {
if (dc == rc)
- SvCUR(sv) = rightlen;
+ SvCUR_set(sv, rightlen);
else
sv_catpvn_nomg(sv, rsave + len, rightlen - len);
}
else if (leftlen > len) {
if (dc == lc)
- SvCUR(sv) = leftlen;
+ SvCUR_set(sv, leftlen);
else
sv_catpvn_nomg(sv, lsave + len, leftlen - len);
}