UV pos1_uv = pos1_iv-arybase;
/* Overflow can occur when $[ < 0 */
if (arybase < 0 && pos1_uv < (UV)pos1_iv)
- goto BOUND_FAIL;
+ goto bound_fail;
pos1_iv = pos1_uv;
pos1_is_uv = 1;
}
else if (pos1_is_uv ? (UV)pos1_iv > 0 : pos1_iv > 0) {
- goto BOUND_FAIL; /* $[=3; substr($_,2,...) */
+ goto bound_fail; /* $[=3; substr($_,2,...) */
}
else { /* pos < $[ */
if (pos1_iv == 0) { /* $[=1; substr($_,0,...) */
}
if (pos1_is_uv || pos1_iv > 0) {
if ((UV)pos1_iv > curlen)
- goto BOUND_FAIL;
+ goto bound_fail;
}
if (num_args > 2) {
if (!pos2_is_uv && pos2_iv < 0) {
if (!pos1_is_uv && pos1_iv < 0)
- goto BOUND_FAIL;
+ goto bound_fail;
pos2_iv = 0;
}
else if (!pos1_is_uv && pos1_iv < 0)
/* pos1_iv and pos2_iv both in 0..curlen, so the cast is safe */
const STRLEN pos = (STRLEN)( (UV)pos1_iv );
const STRLEN len = (STRLEN)( (UV)pos2_iv - (UV)pos1_iv );
- STRLEN byte_pos = pos;
STRLEN byte_len = len;
- if (utf8_curlen)
- sv_pos_u2b_proper(sv, &byte_pos, &byte_len);
+ STRLEN byte_pos = utf8_curlen
+ ? sv_pos_u2b_flags(sv, pos, &byte_len, SV_CONST_RETURN) : pos;
+
tmps += byte_pos;
/* we either return a PV or an LV. If the TARG hasn't been used
* before, or is of that type, reuse it; otherwise use a mortal
PUSHs(TARG); /* avoid SvSETMAGIC here */
RETURN;
-BOUND_FAIL:
+bound_fail:
if (lvalue || repl)
Perl_croak(aTHX_ "substr outside of string");
Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");