Re: Smoke [5.9.0] 21474 FAIL(F) darwin 6.8 (darwin/1 cpu)

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index fc2b9c5..8f2f3e0 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -141,7 +141,7 @@ PP(pp_concat)
 
     if (TARG == right && right != left) {
        right = sv_2mortal(newSVpvn(rpv, rlen));
-       rpv = SvPV(right, rlen);        /* no point setting UTF8 here */
+       rpv = SvPV(right, rlen);        /* no point setting UTF-8 here */
        rcopied = TRUE;
     }
 
@@ -795,6 +795,7 @@ PP(pp_rv2hv)
 {
     dSP; dTOPss;
     HV *hv;
+    I32 gimme = GIMME_V;
 
     if (SvROK(sv)) {
       wasref:
@@ -808,7 +809,7 @@ PP(pp_rv2hv)
            RETURN;
        }
        else if (LVRET) {
-           if (GIMME != G_SCALAR)
+           if (gimme != G_ARRAY)
                Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
            SETs((SV*)hv);
            RETURN;
@@ -825,7 +826,7 @@ PP(pp_rv2hv)
                RETURN;
            }
            else if (LVRET) {
-               if (GIMME == G_SCALAR)
+               if (gimme != G_ARRAY)
                    Perl_croak(aTHX_ "Can't return hash to lvalue"
                               " scalar context");
                SETs((SV*)hv);
@@ -850,7 +851,7 @@ PP(pp_rv2hv)
                        DIE(aTHX_ PL_no_usym, "a HASH");
                    if (ckWARN(WARN_UNINITIALIZED))
                        report_uninit();
-                   if (GIMME == G_ARRAY) {
+                   if (gimme == G_ARRAY) {
                        SP--;
                        RETURN;
                    }
@@ -885,7 +886,7 @@ PP(pp_rv2hv)
                RETURN;
            }
            else if (LVRET) {
-               if (GIMME == G_SCALAR)
+               if (gimme != G_ARRAY)
                    Perl_croak(aTHX_ "Can't return hash to lvalue"
                               " scalar context");
                SETs((SV*)hv);
@@ -894,12 +895,15 @@ PP(pp_rv2hv)
        }
     }
 
-    if (GIMME == G_ARRAY) { /* array wanted */
+    if (gimme == G_ARRAY) { /* array wanted */
        *PL_stack_sp = (SV*)hv;
        return do_kv();
     }
-    else {
+    else if (gimme == G_SCALAR) {
        dTARGET;
+       if (SvRMAGICAL(hv) && mg_find((SV *)hv, PERL_MAGIC_tied))
+           Perl_croak(aTHX_ "Can't provide tied hash usage; "
+                      "use keys(%%hash) to test if empty");
        if (HvFILL(hv))
             Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf,
                           (IV)HvFILL(hv), (IV)HvMAX(hv) + 1);
@@ -907,8 +911,8 @@ PP(pp_rv2hv)
            sv_setiv(TARG, 0);
        
        SETTARG;
-       RETURN;
     }
+    RETURN;
 }
 
 STATIC void
@@ -1062,10 +1066,13 @@ PP(pp_aassign)
     if (PL_delaymagic & ~DM_DELAY) {
        if (PL_delaymagic & DM_UID) {
 #ifdef HAS_SETRESUID
-           (void)setresuid(PL_uid,PL_euid,(Uid_t)-1);
+           (void)setresuid((PL_delaymagic & DM_RUID) ? PL_uid  : (Uid_t)-1,
+                           (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1,
+                           (Uid_t)-1);
 #else
 #  ifdef HAS_SETREUID
-           (void)setreuid(PL_uid,PL_euid);
+           (void)setreuid((PL_delaymagic & DM_RUID) ? PL_uid  : (Uid_t)-1,
+                          (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1);
 #  else
 #    ifdef HAS_SETRUID
            if ((PL_delaymagic & DM_UID) == DM_RUID) {
@@ -1075,7 +1082,7 @@ PP(pp_aassign)
 #    endif /* HAS_SETRUID */
 #    ifdef HAS_SETEUID
            if ((PL_delaymagic & DM_UID) == DM_EUID) {
-               (void)seteuid(PL_uid);
+               (void)seteuid(PL_euid);
                PL_delaymagic &= ~DM_EUID;
            }
 #    endif /* HAS_SETEUID */
@@ -1091,10 +1098,13 @@ PP(pp_aassign)
        }
        if (PL_delaymagic & DM_GID) {
 #ifdef HAS_SETRESGID
-           (void)setresgid(PL_gid,PL_egid,(Gid_t)-1);
+           (void)setresgid((PL_delaymagic & DM_RGID) ? PL_gid  : (Gid_t)-1,
+                           (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1,
+                           (Gid_t)-1);
 #else
 #  ifdef HAS_SETREGID
-           (void)setregid(PL_gid,PL_egid);
+           (void)setregid((PL_delaymagic & DM_RGID) ? PL_gid  : (Gid_t)-1,
+                          (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1);
 #  else
 #    ifdef HAS_SETRGID
            if ((PL_delaymagic & DM_GID) == DM_RGID) {
@@ -1104,7 +1114,7 @@ PP(pp_aassign)
 #    endif /* HAS_SETRGID */
 #    ifdef HAS_SETEGID
            if ((PL_delaymagic & DM_GID) == DM_EGID) {
-               (void)setegid(PL_gid);
+               (void)setegid(PL_egid);
                PL_delaymagic &= ~DM_EGID;
            }
 #    endif /* HAS_SETEGID */
@@ -1234,7 +1244,7 @@ PP(pp_match)
     if (SvSCREAM(TARG))
        r_flags |= REXEC_SCREAM;
 
-    if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+    if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
        SAVEINT(PL_multiline);
        PL_multiline = pm->op_pmflags & PMf_MULTILINE;
     }
@@ -1406,7 +1416,7 @@ yup:                                      /* Confirmed by INTUIT */
        rx->startp[0] = s - truebase;
        rx->endp[0] = s - truebase + rx->minlen;
     }
-    rx->nparens = rx->lastparen = 0;   /* used by @- and @+ */
+    rx->nparens = rx->lastparen = rx->lastcloseparen = 0;      /* used by @-, @+, and $^N */
     LEAVE_SCOPE(oldsave);
     RETPUSHYES;
 
@@ -1593,6 +1603,17 @@ Perl_do_readline(pTHX)
                (void)POPs;             /* Unmatched wildcard?  Chuck it... */
                continue;
            }
+       } else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
+            U8 *s = (U8*)SvPVX(sv) + offset;
+            STRLEN len = SvCUR(sv) - offset;
+            U8 *f;
+            
+            if (ckWARN(WARN_UTF8) &&
+                !Perl_is_utf8_string_loc(aTHX_ s, len, &f))
+                 /* Emulate :encoding(utf8) warning in the same case. */
+                 Perl_warner(aTHX_ packWARN(WARN_UTF8),
+                             "utf8 \"\\x%02X\" does not map to Unicode",
+                             f < (U8*)SvEND(sv) ? *f : 0);
        }
        if (gimme == G_ARRAY) {
            if (SvLEN(sv) - SvCUR(sv) > 20) {
@@ -1861,8 +1882,7 @@ PP(pp_iter)
     }
     if (sv && SvREFCNT(sv) == 0) {
        *itersvp = Nullsv;
-       Perl_croak(aTHX_
-           "Use of freed value in iteration (perhaps you modified the iterated array within the loop?)");
+       Perl_croak(aTHX_ "Use of freed value in iteration");
     }
 
     if (sv)
@@ -1979,7 +1999,7 @@ PP(pp_subst)
               ? REXEC_COPY_STR : 0;
     if (SvSCREAM(TARG))
        r_flags |= REXEC_SCREAM;
-    if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
+    if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
        SAVEINT(PL_multiline);
        PL_multiline = pm->op_pmflags & PMf_MULTILINE;
     }
@@ -2291,6 +2311,7 @@ PP(pp_leavesub)
     SV *sv;
 
     POPBLOCK(cx,newpm);
+    cxstack_ix++; /* temporarily protect top context */
 
     TAINT_NOT;
     if (gimme == G_SCALAR) {
@@ -2329,6 +2350,7 @@ PP(pp_leavesub)
     PUTBACK;
 
     LEAVE;
+    cxstack_ix--;
     POPSUB(cx,sv);     /* Stack values are safe: release CV and @_ ... */
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
@@ -2349,6 +2371,7 @@ PP(pp_leavesublv)
     SV *sv;
 
     POPBLOCK(cx,newpm);
+    cxstack_ix++; /* temporarily protect top context */
 
     TAINT_NOT;
 
@@ -2385,6 +2408,7 @@ PP(pp_leavesublv)
         * TEMP, so sv_2mortal is out of question. */
        if (!CvLVALUE(cx->blk_sub.cv)) {
            LEAVE;
+           cxstack_ix--;
            POPSUB(cx,sv);
            PL_curpm = newpm;
            LEAVESUB(sv);
@@ -2396,6 +2420,7 @@ PP(pp_leavesublv)
            if (MARK == SP) {
                if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
                    LEAVE;
+                   cxstack_ix--;
                    POPSUB(cx,sv);
                    PL_curpm = newpm;
                    LEAVESUB(sv);
@@ -2411,6 +2436,7 @@ PP(pp_leavesublv)
            }
            else {                      /* Should not happen? */
                LEAVE;
+               cxstack_ix--;
                POPSUB(cx,sv);
                PL_curpm = newpm;
                LEAVESUB(sv);
@@ -2427,6 +2453,7 @@ PP(pp_leavesublv)
                    /* Might be flattened array after $#array =  */
                    PUTBACK;
                    LEAVE;
+                   cxstack_ix--;
                    POPSUB(cx,sv);
                    PL_curpm = newpm;
                    LEAVESUB(sv);
@@ -2481,6 +2508,7 @@ PP(pp_leavesublv)
     PUTBACK;
 
     LEAVE;
+    cxstack_ix--;
     POPSUB(cx,sv);     /* Stack values are safe: release CV and @_ ... */
     PL_curpm = newpm;  /* ... and pop $1 et al */