Remove tests for POD or POD coverage -- they're always skipped.

[p5sagit/p5-mst-13.2.git] / pp.c

diff --git a/pp.c b/pp.c
index 7540c99..0ec54bf 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -239,6 +239,7 @@ PP(pp_rv2sv)
        case SVt_PVFM:
        case SVt_PVIO:
            DIE(aTHX_ "Not a SCALAR reference");
+       default: NOOP;
        }
     }
     else {
@@ -386,18 +387,25 @@ PP(pp_prototype)
     SV *ret = &PL_sv_undef;
 
     if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
-       const char * const s = SvPVX_const(TOPs);
+       const char * s = SvPVX_const(TOPs);
        if (strnEQ(s, "CORE::", 6)) {
-           const int code = keyword(s + 6, SvCUR(TOPs) - 6);
+           const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
            if (code < 0) {     /* Overridable. */
 #define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
-               int i = 0, n = 0, seen_question = 0;
+               int i = 0, n = 0, seen_question = 0, defgv = 0;
                I32 oa;
                char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
 
                if (code == -KEY_chop || code == -KEY_chomp
-                       || code == -KEY_exec || code == -KEY_system)
+                       || code == -KEY_exec || code == -KEY_system || code == -KEY_err)
                    goto set;
+               if (code == -KEY_mkdir) {
+                   ret = sv_2mortal(newSVpvs("_;$"));
+                   goto set;
+               }
+               if (code == -KEY_readpipe) {
+                   s = "CORE::backtick";
+               }
                while (i < MAXO) {      /* The slow way. */
                    if (strEQ(s + 6, PL_op_name[i])
                        || strEQ(s + 6, PL_op_desc[i]))
@@ -408,9 +416,10 @@ PP(pp_prototype)
                }
                goto nonesuch;          /* Should not happen... */
              found:
+               defgv = PL_opargs[i] & OA_DEFGV;
                oa = PL_opargs[i] >> OASHIFT;
                while (oa) {
-                   if (oa & OA_OPTIONAL && !seen_question) {
+                   if (oa & OA_OPTIONAL && !seen_question && !defgv) {
                        seen_question = 1;
                        str[n++] = ';';
                    }
@@ -424,6 +433,8 @@ PP(pp_prototype)
                    str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
                    oa = oa >> 4;
                }
+               if (defgv && str[n - 1] == '$')
+                   str[n - 1] = '_';
                str[n++] = '\0';
                ret = sv_2mortal(newSVpvn(str, n - 1));
            }
@@ -643,7 +654,7 @@ PP(pp_study)
     }
     s = (unsigned char*)(SvPV(sv, len));
     pos = len;
-    if (pos <= 0 || !SvPOK(sv)) {
+    if (pos <= 0 || !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
@@ -3126,8 +3137,6 @@ PP(pp_substr)
                sv_upgrade(TARG, SVt_PVLV);
                sv_magic(TARG, NULL, PERL_MAGIC_substr, NULL, 0);
            }
-           else
-               SvOK_off(TARG);
 
            LvTYPE(TARG) = 'x';
            if (LvTARG(TARG) != sv) {
@@ -3301,6 +3310,8 @@ PP(pp_index)
 PP(pp_sprintf)
 {
     dVAR; dSP; dMARK; dORIGMARK; dTARGET;
+    if (SvTAINTED(MARK[1]))
+       TAINT_PROPER("sprintf");
     do_sprintf(TARG, SP-MARK, MARK+1);
     TAINT_IF(SvTAINTED(TARG));
     SP = ORIGMARK;
@@ -3367,20 +3378,21 @@ PP(pp_chr)
     *tmps++ = (char)value;
     *tmps = '\0';
     (void)SvPOK_only(TARG);
+
     if (PL_encoding && !IN_BYTES) {
         sv_recode_to_utf8(TARG, PL_encoding);
        tmps = SvPVX(TARG);
        if (SvCUR(TARG) == 0 || !is_utf8_string((U8*)tmps, SvCUR(TARG)) ||
-           memEQ(tmps, "\xef\xbf\xbd\0", 4)) {
-           SvGROW(TARG, 3);
+           UNICODE_IS_REPLACEMENT(utf8_to_uvchr((U8*)tmps, NULL))) {
+           SvGROW(TARG, 2);
            tmps = SvPVX(TARG);
-           SvCUR_set(TARG, 2);
-           *tmps++ = (U8)UTF8_EIGHT_BIT_HI(value);
-           *tmps++ = (U8)UTF8_EIGHT_BIT_LO(value);
+           SvCUR_set(TARG, 1);
+           *tmps++ = (char)value;
            *tmps = '\0';
-           SvUTF8_on(TARG);
+           SvUTF8_off(TARG);
        }
     }
+
     XPUSHs(TARG);
     RETURN;
 }
@@ -3862,7 +3874,7 @@ PP(pp_each)
 {
     dVAR;
     dSP;
-    HV * const hash = (HV*)POPs;
+    HV * hash = (HV*)POPs;
     HE *entry;
     const I32 gimme = GIMME_V;
 
@@ -4035,7 +4047,7 @@ PP(pp_hslice)
                        STRLEN keylen;
                        const char * const key = SvPV_const(keysv, keylen);
                        SAVEDELETE(hv, savepvn(key,keylen),
-                                  SvUTF8(keysv) ? -keylen : keylen);
+                                  SvUTF8(keysv) ? -(I32)keylen : (I32)keylen);
                    }
                }
             }
@@ -4074,7 +4086,7 @@ PP(pp_lslice)
     SV ** const firstlelem = PL_stack_base + POPMARK + 1;
     register SV ** const firstrelem = lastlelem + 1;
     const I32 arybase = CopARYBASE_get(PL_curcop);
-    I32 is_something_there = PL_op->op_flags & OPf_MOD;
+    I32 is_something_there = FALSE;
 
     register const I32 max = lastrelem - lastlelem;
     register SV **lelem;
@@ -4123,16 +4135,17 @@ PP(pp_anonlist)
 {
     dVAR; dSP; dMARK; dORIGMARK;
     const I32 items = SP - MARK;
-    SV * const av = sv_2mortal((SV*)av_make(items, MARK+1));
+    SV * const av = (SV *) av_make(items, MARK+1);
     SP = ORIGMARK;             /* av_make() might realloc stack_sp */
-    XPUSHs(av);
+    XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
+                     ? newRV_noinc(av) : av));
     RETURN;
 }
 
 PP(pp_anonhash)
 {
     dVAR; dSP; dMARK; dORIGMARK;
-    HV* const hv = (HV*)sv_2mortal((SV*)newHV());
+    HV* const hv = newHV();
 
     while (MARK < SP) {
        SV * const key = *++MARK;
@@ -4144,7 +4157,8 @@ PP(pp_anonhash)
        (void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
-    XPUSHs((SV*)hv);
+    XPUSHs(sv_2mortal((PL_op->op_flags & OPf_SPECIAL)
+                     ? newRV_noinc((SV*) hv) : (SV*)hv));
     RETURN;
 }
 
@@ -4264,7 +4278,7 @@ PP(pp_splice)
                    *dst-- = *src--;
            }
            dst = AvARRAY(ary);
-           SvPV_set(ary, (char*)(AvARRAY(ary) - diff)); /* diff is negative */
+           AvARRAY(ary) = AvARRAY(ary) - diff; /* diff is negative */
            AvMAX(ary) += diff;
        }
        else {
@@ -4300,7 +4314,7 @@ PP(pp_splice)
                    dst = src - diff;
                    Move(src, dst, offset, SV*);
                }
-               SvPV_set(ary, (char*)(AvARRAY(ary) - diff));/* diff is positive */
+               AvARRAY(ary) = AvARRAY(ary) - diff;/* diff is positive */
                AvMAX(ary) += diff;
                AvFILLp(ary) += diff;
            }
@@ -4636,9 +4650,9 @@ PP(pp_split)
             && (rx->reganch & ROPT_CHECK_ALL)
             && !(rx->reganch & ROPT_ANCH)) {
        const int tail = (rx->reganch & RE_INTUIT_TAIL);
-       SV * const csv = CALLREG_INTUIT_STRING(aTHX_ rx);
+       SV * const csv = CALLREG_INTUIT_STRING(rx);
 
-       len = rx->minlen;
+       len = rx->minlenret;
        if (len == 1 && !(rx->reganch & ROPT_UTF8) && !tail) {
            const char c = *SvPV_nolen_const(csv);
            while (--limit) {
@@ -4686,7 +4700,7 @@ PP(pp_split)
        {
            I32 rex_return;
            PUTBACK;
-           rex_return = CALLREGEXEC(aTHX_ rx, (char*)s, (char*)strend, (char*)orig, 1 ,
+           rex_return = CALLREGEXEC(rx, (char*)s, (char*)strend, (char*)orig, 1 ,
                            sv, NULL, 0);
            SPAGAIN;
            if (rex_return == 0)