[perl #82706] Tidy up README.win32 pod.

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 0713ec6..d2bb466 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -121,7 +121,7 @@ PP(pp_padhv)
     }
     gimme = GIMME_V;
     if (gimme == G_ARRAY) {
-       RETURNOP(do_kv());
+       RETURNOP(Perl_do_kv(aTHX));
     }
     else if (gimme == G_SCALAR) {
        SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
@@ -248,7 +248,10 @@ Perl_softref2xv(pTHX_ SV *const sv, const char *const what,
            Perl_die(aTHX_ PL_no_usym, what);
     }
     if (!SvOK(sv)) {
-       if (PL_op->op_flags & OPf_REF)
+       if (
+         PL_op->op_flags & OPf_REF &&
+         PL_op->op_next->op_type != OP_BOOLKEYS
+       )
            Perl_die(aTHX_ PL_no_usym, what);
        if (ckWARN(WARN_UNINITIALIZED))
            report_uninit(sv);
@@ -1045,7 +1048,7 @@ PP(pp_undef)
 
            gp_free(MUTABLE_GV(sv));
            Newxz(gp, 1, GP);
-           GvGP(sv) = gp_ref(gp);
+           GvGP_set(sv, gp_ref(gp));
            GvSV(sv) = newSV(0);
            GvLINE(sv) = CopLINE(PL_curcop);
            GvEGV(sv) = MUTABLE_GV(sv);
@@ -1495,7 +1498,7 @@ PP(pp_divide)
                warning before dieing, hence this test goes here.
                If it were immediately before the second SvIV_please, then
                DIE() would be invoked before left was even inspected, so
-               no inpsection would give no warning.  */
+               no inspection would give no warning.  */
             if (right == 0)
                 DIE(aTHX_ "Illegal division by zero");
 
@@ -4835,8 +4838,8 @@ PP(pp_rkeys)
        SvGETMAGIC(sv);
        if (SvAMAGIC(sv)) {
            /* N.B.: AMG macros return sv if no overloading is found */
-           SV *maybe_hv = AMG_CALLun(sv,to_hv);
-           SV *maybe_av = AMG_CALLun(sv,to_av);
+           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 %%{}",
@@ -5431,14 +5434,9 @@ PP(pp_splice)
     const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
 
     if (mg) {
-       *MARK-- = SvTIED_obj(MUTABLE_SV(ary), mg);
-       PUSHMARK(MARK);
-       PUTBACK;
-       ENTER_with_name("call_SPLICE");
-       call_method("SPLICE",GIMME_V);
-       LEAVE_with_name("call_SPLICE");
-       SPAGAIN;
-       RETURN;
+       return Perl_tied_method(aTHX_ "SPLICE", mark - 1, MUTABLE_SV(ary), mg,
+                                   GIMME_V | TIED_METHOD_ARGUMENTS_ON_STACK,
+                                   sp - mark);
     }
 
     SP++;
@@ -5505,7 +5503,7 @@ PP(pp_splice)
            if (AvREAL(ary)) {
                EXTEND_MORTAL(length);
                for (i = length, dst = MARK; i; i--) {
-                   sv_2mortal(*dst);   /* free them eventualy */
+                   sv_2mortal(*dst);   /* free them eventually */
                    dst++;
                }
            }
@@ -5597,7 +5595,7 @@ PP(pp_splice)
                if (AvREAL(ary)) {
                    EXTEND_MORTAL(length);
                    for (i = length, dst = MARK; i; i--) {
-                       sv_2mortal(*dst);       /* free them eventualy */
+                       sv_2mortal(*dst);       /* free them eventually */
                        dst++;
                    }
                }
@@ -5875,7 +5873,7 @@ PP(pp_split)
        DIE(aTHX_ "panic: pp_split");
     rx = PM_GETRE(pm);
 
-    TAINT_IF((RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) &&
+    TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET &&
             (RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
 
     RX_MATCH_UTF8_set(rx, do_utf8);
@@ -5921,7 +5919,7 @@ PP(pp_split)
            while (*s == ' ' || is_utf8_space((U8*)s))
                s += UTF8SKIP(s);
        }
-       else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
+       else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
            while (isSPACE_LC(*s))
                s++;
        }
@@ -5930,7 +5928,7 @@ PP(pp_split)
                s++;
        }
     }
-    if (RX_EXTFLAGS(rx) & PMf_MULTILINE) {
+    if (RX_EXTFLAGS(rx) & RXf_PMf_MULTILINE) {
        multiline = 1;
     }
 
@@ -5951,7 +5949,8 @@ PP(pp_split)
                    else
                        m += t;
                }
-            } else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
+           }
+           else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
                while (m < strend && !isSPACE_LC(*m))
                    ++m;
             } else {
@@ -5983,7 +5982,8 @@ PP(pp_split)
            if (do_utf8) {
                while (s < strend && ( *s == ' ' || is_utf8_space((U8*)s) ))
                    s +=  UTF8SKIP(s);
-            } else if (RX_EXTFLAGS(rx) & RXf_PMf_LOCALE) {
+           }
+           else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
                while (s < strend && isSPACE_LC(*s))
                    ++s;
             } else {
@@ -6300,8 +6300,20 @@ PP(pp_lock)
 PP(unimplemented_op)
 {
     dVAR;
-    DIE(aTHX_ "panic: unimplemented op %s (#%d) called", OP_NAME(PL_op),
-       PL_op->op_type);
+    const Optype op_type = PL_op->op_type;
+    /* Using OP_NAME() isn't going to be helpful here. Firstly, it doesn't cope
+       with out of range op numbers - it only "special" cases op_custom.
+       Secondly, as the three ops we "panic" on are padmy, mapstart and custom,
+       if we get here for a custom op then that means that the custom op didn't
+       have an implementation. Given that OP_NAME() looks up the custom op
+       by its pp_addr, likely it will return NULL, unless someone (unhelpfully)
+       registers &PL_unimplemented_op as the address of their custom op.
+       NULL doesn't generate a useful error message. "custom" does. */
+    const char *const name = op_type >= OP_max
+       ? "[out of range]" : PL_op_name[PL_op->op_type];
+    if(OP_IS_SOCKET(op_type))
+       DIE(aTHX_ PL_no_sock_func, name);
+    DIE(aTHX_ "panic: unimplemented op %s (#%d) called", name, op_type);
 }
 
 PP(pp_boolkeys)
@@ -6310,6 +6322,8 @@ PP(pp_boolkeys)
     dSP;
     HV * const hv = (HV*)POPs;
     
+    if (SvTYPE(hv) != SVt_PVHV) { XPUSHs(&PL_sv_no); RETURN; }
+
     if (SvRMAGICAL(hv)) {
        MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
        if (mg) {