RETPUSHYES;
}
s = (unsigned char*)(SvPV(sv, len));
- pos = len;
- if (pos <= 0 || !SvPOK(sv) || SvUTF8(sv)) {
+ if (len == 0 || len > I32_MAX || !SvPOK(sv) || SvUTF8(sv)) {
/* No point in studying a zero length string, and not safe to study
anything that doesn't appear to be a simple scalar (and hence might
change between now and when the regexp engine runs without our set
stringification. */
RETPUSHNO;
}
+ pos = len;
if (PL_lastscream) {
SvSCREAM_off(PL_lastscream);
}
PL_lastscream = SvREFCNT_inc_simple(sv);
- s = (unsigned char*)(SvPV(sv, len));
- pos = len;
- if (pos <= 0)
- RETPUSHNO;
if (pos > PL_maxscream) {
if (PL_maxscream < 0) {
PL_maxscream = pos + 80;
dSP;
dPOPss;
- if (!SvOK(sv))
- RETURN;
-
- if (SvROK(sv)) {
- SvGETMAGIC(sv);
- if (SvAMAGIC(sv)) {
- /* N.B.: AMG macros return sv if no overloading is found */
- SV *maybe_hv = AMG_CALLunary(sv, to_hv_amg);
- SV *maybe_av = AMG_CALLunary(sv, to_av_amg);
- if ( maybe_hv != sv && maybe_av != sv ) {
- Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
- Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as %%{}",
- PL_op_desc[PL_op->op_type]
- )
- );
- sv = maybe_hv;
- }
- else if ( maybe_av != sv ) {
- if ( SvTYPE(SvRV(sv)) == SVt_PVHV ) {
- /* @{} overload, but underlying reftype is HV */
- Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
- Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as @{}",
- PL_op_desc[PL_op->op_type]
- )
- );
- }
- sv = maybe_av;
- }
- else if ( maybe_hv != sv ) {
- if ( SvTYPE(SvRV(sv)) == SVt_PVAV ) {
- /* %{} overload, but underlying reftype is AV */
- Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "%s",
- Perl_form(aTHX_ "Ambiguous overloaded argument to %s resolved as %%{}",
- PL_op_desc[PL_op->op_type]
- )
- );
- }
- sv = maybe_hv;
- }
- }
- sv = SvRV(sv);
- }
-
- if ( SvTYPE(sv) != SVt_PVHV && SvTYPE(sv) != SVt_PVAV ) {
- DIE(aTHX_ "Type of argument to %s must be hashref or arrayref",
+ SvGETMAGIC(sv);
+
+ if (
+ !SvROK(sv)
+ || (sv = SvRV(sv),
+ (SvTYPE(sv) != SVt_PVHV && SvTYPE(sv) != SVt_PVAV)
+ || SvOBJECT(sv)
+ )
+ ) {
+ DIE(aTHX_
+ "Type of argument to %s must be unblessed hashref or arrayref",
PL_op_desc[PL_op->op_type] );
}
+ if (PL_op->op_flags & OPf_SPECIAL && SvTYPE(sv) == SVt_PVAV)
+ DIE(aTHX_
+ "Can't modify %s in %s",
+ PL_op_desc[PL_op->op_type], PL_op_desc[PL_op->op_next->op_type]
+ );
+
/* Delegate to correct function for op type */
PUSHs(sv);
if (PL_op->op_type == OP_RKEYS || PL_op->op_type == OP_RVALUES) {
S_deref_plain_array(pTHX_ AV *ary)
{
if (SvTYPE(ary) == SVt_PVAV) return ary;
+ SvGETMAGIC((SV *)ary);
if (!SvROK(ary) || SvTYPE(SvRV(ary)) != SVt_PVAV)
Perl_die(aTHX_ "Not an ARRAY reference");
else if (SvOBJECT(SvRV(ary)))
#else
# define DEREF_PLAIN_ARRAY(ary) \
( \
- PL_Sv = (SV *)(ary); \
+ PL_Sv = (SV *)(ary), \
SvTYPE(PL_Sv) == SVt_PVAV \
? (AV *)PL_Sv \
- : S_deref_plain_array(aTHX_ (AV *)PL_Sv); \
+ : S_deref_plain_array(aTHX_ (AV *)PL_Sv) \
)
#endif
}
}
- XPUSHs(boolSV(HvKEYS(hv) != 0));
+ XPUSHs(boolSV(HvUSEDKEYS(hv) != 0));
RETURN;
}