add -pipe to gcc's default flags
[p5sagit/p5-mst-13.2.git] / pp_hot.c
index 0bcb7bd..d02bf96 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1,7 +1,7 @@
 /*    pp_hot.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -137,7 +137,7 @@ PP(pp_concat)
     bool lbyte;
     STRLEN rlen;
     char* rpv = SvPV(right, rlen);     /* mg_get(right) happens here */
-    bool rbyte = !SvUTF8(right), rcopied = FALSE;
+    bool rbyte = !DO_UTF8(right), rcopied = FALSE;
 
     if (TARG == right && right != left) {
        right = sv_2mortal(newSVpvn(rpv, rlen));
@@ -147,7 +147,7 @@ PP(pp_concat)
 
     if (TARG != left) {
        lpv = SvPV(left, llen);         /* mg_get(left) may happen here */
-       lbyte = !SvUTF8(left);
+       lbyte = !DO_UTF8(left);
        sv_setpvn(TARG, lpv, llen);
        if (!lbyte)
            SvUTF8_on(TARG);
@@ -160,7 +160,9 @@ PP(pp_concat)
        if (!SvOK(TARG))
            sv_setpv(left, "");
        lpv = SvPV_nomg(left, llen);
-       lbyte = !SvUTF8(left);
+       lbyte = !DO_UTF8(left);
+       if (IN_BYTES)
+           SvUTF8_off(TARG);
     }
 
 #if defined(PERL_Y2KWARN)
@@ -295,7 +297,7 @@ PP(pp_eq)
 PP(pp_preinc)
 {
     dSP;
-    if (SvTYPE(TOPs) > SVt_PVLV)
+    if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
        DIE(aTHX_ PL_no_modify);
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MAX)
@@ -521,7 +523,8 @@ PP(pp_add)
 PP(pp_aelemfast)
 {
     dSP;
-    AV *av = GvAV(cGVOP_gv);
+    AV *av = PL_op->op_flags & OPf_SPECIAL ?
+               (AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv);
     U32 lval = PL_op->op_flags & OPf_MOD;
     SV** svp = av_fetch(av, PL_op->op_private, lval);
     SV *sv = (svp ? *svp : &PL_sv_undef);
@@ -722,7 +725,7 @@ PP(pp_rv2av)
                      PL_op->op_private & HINT_STRICT_REFS)
                        DIE(aTHX_ PL_no_usym, "an ARRAY");
                    if (ckWARN(WARN_UNINITIALIZED))
-                       report_uninit();
+                       report_uninit(sv);
                    if (GIMME == G_ARRAY) {
                        (void)POPs;
                        RETURN;
@@ -775,7 +778,10 @@ PP(pp_rv2av)
            U32 i;
            for (i=0; i < (U32)maxarg; i++) {
                SV **svp = av_fetch(av, i, FALSE);
-               SP[i+1] = (svp) ? *svp : &PL_sv_undef;
+               /* See note in pp_helem, and bug id #27839 */
+               SP[i+1] = svp
+                   ? SvGMAGICAL(*svp) ? sv_mortalcopy(*svp) : *svp
+                   : &PL_sv_undef;
            }
        }
        else {
@@ -850,7 +856,7 @@ PP(pp_rv2hv)
                      PL_op->op_private & HINT_STRICT_REFS)
                        DIE(aTHX_ PL_no_usym, "a HASH");
                    if (ckWARN(WARN_UNINITIALIZED))
-                       report_uninit();
+                       report_uninit(sv);
                    if (gimme == G_ARRAY) {
                        SP--;
                        RETURN;
@@ -901,15 +907,7 @@ PP(pp_rv2hv)
     }
     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);
-       else
-           sv_setiv(TARG, 0);
-       
+    TARG = Perl_hv_scalar(aTHX_ hv);
        SETTARG;
     }
     RETURN;
@@ -967,7 +965,8 @@ PP(pp_aassign)
     I32 i;
     int magic;
     int duplicates = 0;
-    SV **firsthashrelem;
+    SV **firsthashrelem = 0;   /* "= 0" keeps gcc 2.95 quiet  */
+
 
     PL_delaymagic = DM_DELAY;          /* catch simultaneous items */
     gimme = GIMME_V;
@@ -1202,6 +1201,8 @@ PP(pp_match)
 
     if (PL_op->op_flags & OPf_STACKED)
        TARG = POPs;
+    else if (PL_op->op_private & OPpTARGET_MY)
+       GETTARGET;
     else {
        TARG = DEFSV;
        EXTEND(SP,1);
@@ -1319,10 +1320,10 @@ play_it_again:
            /*SUPPRESS 560*/
            if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
                len = rx->endp[i] - rx->startp[i];
+               s = rx->startp[i] + truebase;
                if (rx->endp[i] < 0 || rx->startp[i] < 0 ||
                    len < 0 || len > strend - s)
                    DIE(aTHX_ "panic: pp_match start/end pointers");
-               s = rx->startp[i] + truebase;
                sv_setpvn(*SP, s, len);
                if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
                    SvUTF8_on(*SP);
@@ -1839,8 +1840,8 @@ PP(pp_iter)
        if (cx->blk_loop.iterlval) {
            /* string increment */
            register SV* cur = cx->blk_loop.iterlval;
-           STRLEN maxlen;
-           char *max = SvPV((SV*)av, maxlen);
+           STRLEN maxlen = 0;
+           char *max = SvOK((SV*)av) ? SvPV((SV*)av, maxlen) : "";
            if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
                if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
                    /* safe to reuse old SV */
@@ -1965,6 +1966,8 @@ PP(pp_subst)
     dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
     if (PL_op->op_flags & OPf_STACKED)
        TARG = POPs;
+    else if (PL_op->op_private & OPpTARGET_MY)
+       GETTARGET;
     else {
        TARG = DEFSV;
        EXTEND(SP,1);
@@ -1983,8 +1986,8 @@ PP(pp_subst)
        !is_cow &&
 #endif
        (SvREADONLY(TARG)
-       || (SvTYPE(TARG) > SVt_PVLV
-           && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
+       || ( (SvTYPE(TARG) == SVt_PVGV || SvTYPE(TARG) > SVt_PVLV)
+            && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
        DIE(aTHX_ PL_no_modify);
     PUTBACK;
 
@@ -2297,8 +2300,15 @@ PP(pp_grepwhile)
        (void)POPMARK;                          /* pop dst */
        SP = PL_stack_base + POPMARK;           /* pop original mark */
        if (gimme == G_SCALAR) {
-           dTARGET;
-           XPUSHi(items);
+           if (PL_op->op_private & OPpGREP_LEX) {
+               SV* sv = sv_newmortal();
+               sv_setiv(sv, items);
+               PUSHs(sv);
+           }
+           else {
+               dTARGET;
+               XPUSHi(items);
+           }
        }
        else if (gimme == G_ARRAY)
            SP += items;
@@ -2312,7 +2322,10 @@ PP(pp_grepwhile)
 
        src = PL_stack_base[*PL_markstack_ptr];
        SvTEMP_off(src);
-       DEFSV = src;
+       if (PL_op->op_private & OPpGREP_LEX)
+           PAD_SVl(PL_op->op_targ) = src;
+       else
+           DEFSV = src;
 
        RETURNOP(cLOGOP->op_other);
     }
@@ -2670,9 +2683,7 @@ PP(pp_entersub)
         * Owing the speed considerations, we choose instead to search for
         * the cv using find_runcv() when calling doeval().
         */
-       if (CvDEPTH(cv) < 2)
-           (void)SvREFCNT_inc(cv);
-       else {
+       if (CvDEPTH(cv) >= 2) {
            PERL_STACK_OVERFLOW_CHECK();
            pad_push(padlist, CvDEPTH(cv), 1);
        }