&& block_gimme() == G_VOID ))
&& (!SvRMAGICAL(TARG) || !mg_find(TARG, PERL_MAGIC_tied))
)
- SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : sv_2mortal(newSViv(0)));
+ SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : &PL_sv_no);
else if (gimme == G_SCALAR) {
SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
SETs(sv);
tmps = SvPV_force_nomg(sv, curlen);
if (DO_UTF8(repl_sv) && repl_len) {
if (!DO_UTF8(sv)) {
+ /* Upgrade the dest, and recalculate tmps in case the buffer
+ * got reallocated; curlen may also have been changed */
sv_utf8_upgrade_nomg(sv);
- curlen = SvCUR(sv);
+ tmps = SvPV_nomg(sv, curlen);
}
}
else if (DO_UTF8(sv))
{
dSP;
const IV size = POPi;
- const IV offset = POPi;
+ SV* offsetsv = POPs;
SV * const src = POPs;
const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
SV * ret;
+ UV retuv = 0;
+ STRLEN offset;
+
+ /* extract a STRLEN-ranged integer value from offsetsv into offset,
+ * or die trying */
+ {
+ IV iv = SvIV(offsetsv);
+
+ /* avoid a large UV being wrapped to a negative value */
+ if (SvIOK_UV(offsetsv) && SvUVX(offsetsv) > (UV)IV_MAX) {
+ if (!lvalue)
+ goto return_val; /* out of range: return 0 */
+ Perl_croak_nocontext("Out of memory!");
+ }
+
+ if (iv < 0) {
+ if (!lvalue)
+ goto return_val; /* out of range: return 0 */
+ Perl_croak_nocontext("Negative offset to vec in lvalue context");
+ }
+
+#if PTRSIZE < IVSIZE
+ if (iv > Size_t_MAX) {
+ if (!lvalue)
+ goto return_val; /* out of range: return 0 */
+ Perl_croak_nocontext("Out of memory!");
+ }
+#endif
+
+ offset = (STRLEN)iv;
+ }
+
+ retuv = do_vecget(src, offset, size);
+
+ return_val:
if (lvalue) { /* it's an lvalue! */
ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */
ret = TARG;
}
- sv_setuv(ret, do_vecget(src, offset, size));
+
+ sv_setuv(ret, retuv);
if (!lvalue)
SvSETMAGIC(ret);
PUSHs(ret);
const U8 *s = (U8*)SvPV_const(argsv, len);
SETu(DO_UTF8(argsv)
- ? utf8n_to_uvchr(s, len, 0, UTF8_ALLOW_ANYUV)
+ ? (len ? utf8n_to_uvchr(s, len, 0, UTF8_ALLOW_ANYUV) : 0)
: (UV)(*s));
return NORMAL;
ulen = UTF8SKIP(s);
if (op_type == OP_UCFIRST) {
#ifdef USE_LOCALE_CTYPE
- _toTITLE_utf8_flags(s, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
+ _toTITLE_utf8_flags(s, s +slen, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
#else
- _toTITLE_utf8_flags(s, tmpbuf, &tculen, 0);
+ _toTITLE_utf8_flags(s, s +slen, tmpbuf, &tculen, 0);
#endif
}
else {
#ifdef USE_LOCALE_CTYPE
- _toLOWER_utf8_flags(s, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
+ _toLOWER_utf8_flags(s, s + slen, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
#else
- _toLOWER_utf8_flags(s, tmpbuf, &tculen, 0);
+ _toLOWER_utf8_flags(s, s + slen, tmpbuf, &tculen, 0);
#endif
}
u = UTF8SKIP(s);
#ifdef USE_LOCALE_CTYPE
- uv = _toUPPER_utf8_flags(s, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
+ uv = _toUPPER_utf8_flags(s, send, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
#else
- uv = _toUPPER_utf8_flags(s, tmpbuf, &ulen, 0);
+ uv = _toUPPER_utf8_flags(s, send, tmpbuf, &ulen, 0);
#endif
#define GREEK_CAPITAL_LETTER_IOTA 0x0399
#define COMBINING_GREEK_YPOGEGRAMMENI 0x0345
STRLEN ulen;
#ifdef USE_LOCALE_CTYPE
- _toLOWER_utf8_flags(s, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
+ _toLOWER_utf8_flags(s, send, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
#else
- _toLOWER_utf8_flags(s, tmpbuf, &ulen, 0);
+ _toLOWER_utf8_flags(s, send, tmpbuf, &ulen, 0);
#endif
/* Here is where we would do context-sensitive actions. See the
const STRLEN u = UTF8SKIP(s);
STRLEN ulen;
- _toFOLD_utf8_flags(s, tmpbuf, &ulen, flags);
+ _toFOLD_utf8_flags(s, send, tmpbuf, &ulen, flags);
if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
const UV o = d - (U8*)SvPVX_const(dest);
}
else {
char *up;
- char *down;
- I32 tmp;
dTARGET;
STRLEN len;
up = SvPV_force(TARG, len);
if (len > 1) {
+ char *down;
if (DO_UTF8(TARG)) { /* first reverse each character */
U8* s = (U8*)SvPVX(TARG);
const U8* send = (U8*)(s + len);
down = (char*)(s - 1);
/* reverse this character */
while (down > up) {
- tmp = *up;
+ const char tmp = *up;
*up++ = *down;
- *down-- = (char)tmp;
+ *down-- = tmp;
}
}
}
}
down = SvPVX(TARG) + len - 1;
while (down > up) {
- tmp = *up;
+ const char tmp = *up;
*up++ = *down;
- *down-- = (char)tmp;
+ *down-- = tmp;
}
(void)SvPOK_only_UTF8(TARG);
}
orig = s;
if (RX_EXTFLAGS(rx) & RXf_SKIPWHITE) {
if (do_utf8) {
- while (isSPACE_utf8_safe(s, strend))
+ while (s < strend && isSPACE_utf8_safe(s, strend))
s += UTF8SKIP(s);
}
else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
- while (isSPACE_LC(*s))
+ while (s < strend && isSPACE_LC(*s))
s++;
}
else {
- while (isSPACE(*s))
+ while (s < strend && isSPACE(*s))
s++;
}
}
}
GETTARGET;
- PUSHi(iters);
+ XPUSHi(iters);
RETURN;
}
}
+static SV *
+S_find_runcv_name(void)
+{
+ dTHX;
+ CV *cv;
+ GV *gv;
+ SV *sv;
+
+ cv = find_runcv(0);
+ if (!cv)
+ return &PL_sv_no;
+
+ gv = CvGV(cv);
+ if (!gv)
+ return &PL_sv_no;
+
+ sv = sv_2mortal(newSV(0));
+ gv_fullname4(sv, gv, NULL, TRUE);
+ return sv;
+}
/* Check a a subs arguments - i.e. that it has the correct number of args
* (and anything else we might think of in future). Typically used with
too_few = (argc < (params - opt_params));
if (UNLIKELY(too_few || (!slurpy && argc > params)))
- /* diag_listed_as: Too few arguments for subroutine */
- /* diag_listed_as: Too many arguments for subroutine */
- Perl_croak_caller("Too %s arguments for subroutine",
- too_few ? "few" : "many");
+ /* diag_listed_as: Too few arguments for subroutine '%s' */
+ /* diag_listed_as: Too many arguments for subroutine '%s' */
+ Perl_croak_caller("Too %s arguments for subroutine '%" SVf "'",
+ too_few ? "few" : "many", S_find_runcv_name());
if (UNLIKELY(slurpy == '%' && argc > params && (argc - params) % 2))
- Perl_croak_caller("Odd name/value argument for subroutine");
-
+ /* diag_listed_as: Odd name/value argument for subroutine '%s' */
+ Perl_croak_caller("Odd name/value argument for subroutine '%" SVf "'",
+ S_find_runcv_name());
return NORMAL;
}
https://perl5.git.perl.org / perl5.git / blobdiff