This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #82706] Tidy up README.win32 pod.
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index ba12f6c..d2bb466 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -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);
@@ -5870,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);
@@ -5916,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++;
        }
@@ -5925,7 +5928,7 @@ PP(pp_split)
                s++;
        }
     }
-    if (RX_EXTFLAGS(rx) & PMf_MULTILINE) {
+    if (RX_EXTFLAGS(rx) & RXf_PMf_MULTILINE) {
        multiline = 1;
     }
 
@@ -5946,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 {
@@ -5978,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 {
@@ -6306,6 +6311,8 @@ PP(unimplemented_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);
 }
 
@@ -6315,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) {