This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pp_formline: split FF_LINEGLOB into two blocks
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index 058a068..9579503 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -712,8 +712,7 @@ PP(pp_study)
            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
@@ -721,6 +720,7 @@ PP(pp_study)
           stringification.  */
        RETPUSHNO;
     }
+    pos = len;
 
     if (PL_lastscream) {
        SvSCREAM_off(PL_lastscream);
@@ -728,10 +728,6 @@ PP(pp_study)
     }
     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;
@@ -4836,54 +4832,26 @@ PP(pp_rkeys)
     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) {
@@ -5428,6 +5396,7 @@ static AV *
 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)))
@@ -6366,7 +6335,7 @@ PP(pp_boolkeys)
         }          
     }
 
-    XPUSHs(boolSV(HvKEYS(hv) != 0));
+    XPUSHs(boolSV(HvUSEDKEYS(hv) != 0));
     RETURN;
 }