OS X: could not -Doptimize=-g.

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

diff --git a/pp_ctl.c b/pp_ctl.c
index e22297e..91fc2ca 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,6 +1,7 @@
 /*    pp_ctl.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, 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.
@@ -97,7 +98,7 @@ PP(pp_regcomp)
            memNE(PM_GETRE(pm)->precomp, t, len))
        {
            if (PM_GETRE(pm)) {
-               ReREFCNT_dec(PM_GETRE(pm));
+               ReREFCNT_dec(PM_GETRE(pm));
                PM_SETRE(pm, Null(REGEXP*));    /* crucial if regcomp aborts */
            }
            if (PL_op->op_flags & OPf_SPECIAL)
@@ -158,6 +159,15 @@ PP(pp_substcont)
     register REGEXP *rx = cx->sb_rx;
     SV *nsv = Nullsv;
 
+    { 
+      REGEXP *old = PM_GETRE(pm);
+      if(old != rx) {
+       if(old) 
+         ReREFCNT_dec(old);
+       PM_SETRE(pm,rx);
+      }
+    }
+
     rxres_restore(&cx->sb_rxres, rx);
     RX_MATCH_UTF8_set(rx, SvUTF8(cx->sb_targ));
 
@@ -212,6 +222,7 @@ PP(pp_substcont)
            SvTAINT(targ);
 
            LEAVE_SCOPE(cx->sb_oldsave);
+           ReREFCNT_dec(rx);
            POPSUBST(cx);
            RETURNOP(pm->op_next);
        }
@@ -247,6 +258,7 @@ PP(pp_substcont)
            sv_pos_b2u(sv, &i);
        mg->mg_len = i;
     }
+    ReREFCNT_inc(rx);
     cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
     rxres_save(&cx->sb_rxres, rx);
     RETURNOP(pm->op_pmreplstart);
@@ -357,6 +369,7 @@ PP(pp_formline)
     STRLEN fudge = SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1;
     bool item_is_utf8 = FALSE;
     bool targ_is_utf8 = FALSE;
+    SV * nsv = Nullsv;
 
     if (!SvMAGICAL(tmpForm) || !SvCOMPILED(tmpForm)) {
        if (SvREADONLY(tmpForm)) {
@@ -417,15 +430,10 @@ PP(pp_formline)
        case FF_LITERAL:
            arg = *fpc++;
            if (targ_is_utf8 && !SvUTF8(tmpForm)) {
-               while (arg--) {
-                   if (!NATIVE_IS_INVARIANT(*f)) {
-                       U8 ch = NATIVE_TO_ASCII(*f++);
-                       *t++ = (U8)UTF8_EIGHT_BIT_HI(ch);
-                       *t++ = (U8)UTF8_EIGHT_BIT_LO(ch);
-                   }
-                   else 
-                       *t++ = *f++;
-               }
+               SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+               *t = '\0';
+               sv_catpvn_utf8_upgrade(PL_formtarget, f, arg, nsv);
+               t = SvEND(PL_formtarget);
                break;
            }
            if (!targ_is_utf8 && DO_UTF8(tmpForm)) {
@@ -635,6 +643,21 @@ PP(pp_formline)
                }
                break;
            }
+           if (targ_is_utf8 && !item_is_utf8) {
+               SvCUR_set(PL_formtarget, t - SvPVX(PL_formtarget));
+               *t = '\0';
+               sv_catpvn_utf8_upgrade(PL_formtarget, s, arg, nsv);
+               for (; t < SvEND(PL_formtarget); t++) {
+#ifdef EBCDIC
+                   int ch = *t++ = *s++;
+                   if (iscntrl(ch))
+#else
+                   if (!(*t & ~31))
+#endif
+                       *t = ' ';
+               }
+               break;
+           }
            while (arg--) {
 #ifdef EBCDIC
                int ch = *t++ = *s++;
@@ -1624,8 +1647,18 @@ PP(pp_caller)
                (old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0))
             mask = newSVpvn(WARN_NONEstring, WARNsize) ;
         else if (old_warnings == pWARN_ALL ||
-                 (old_warnings == pWARN_STD && PL_dowarn & G_WARN_ON))
-            mask = newSVpvn(WARN_ALLstring, WARNsize) ;
+                 (old_warnings == pWARN_STD && PL_dowarn & G_WARN_ON)) {
+           /* Get the bit mask for $warnings::Bits{all}, because
+            * it could have been extended by warnings::register */
+           SV **bits_all;
+           HV *bits = get_hv("warnings::Bits", FALSE);
+           if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
+               mask = newSVsv(*bits_all);
+           }
+           else {
+               mask = newSVpvn(WARN_ALLstring, WARNsize) ;
+           }
+       }
         else
             mask = newSVsv(old_warnings);
         PUSHs(sv_2mortal(mask));
@@ -1928,6 +1961,7 @@ PP(pp_return)
     }
     PL_stack_sp = newsp;
 
+    LEAVE;
     /* Stack values are safe: */
     if (popsub2) {
        POPSUB(cx,sv);  /* release CV and @_ ... */
@@ -1936,7 +1970,6 @@ PP(pp_return)
        sv = Nullsv;
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
-    LEAVE;
     LEAVESUB(sv);
     if (clear_errsv)
        sv_setpv(ERRSV,"");
@@ -2012,6 +2045,7 @@ PP(pp_last)
     SP = newsp;
     PUTBACK;
 
+    LEAVE;
     /* Stack values are safe: */
     switch (pop2) {
     case CXt_LOOP:
@@ -2024,7 +2058,6 @@ PP(pp_last)
     }
     PL_curpm = newpm;  /* ... and pop $1 et al */
 
-    LEAVE;
     LEAVESUB(sv);
     return nextop;
 }
@@ -2182,6 +2215,7 @@ PP(pp_goto)
            }
 
            /* First do some returnish stuff. */
+           SvREFCNT_inc(cv); /* avoid premature free during unwind */
            FREETMPS;
            cxix = dopoptosub(cxstack_ix);
            if (cxix < 0)
@@ -2211,6 +2245,8 @@ PP(pp_goto)
                    AvFLAGS(av) = AVf_REIFY;
                    PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
                }
+               else
+                   CLEAR_ARGARRAY(av);
            }
            else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */
                AV* av;
@@ -2229,6 +2265,7 @@ PP(pp_goto)
 
            /* Now do some callish stuff. */
            SAVETMPS;
+           SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
            if (CvXSUB(cv)) {
 #ifdef PERL_XSUB_OLDSTYLE
                if (CvOLDSTYLE(cv)) {
@@ -2861,7 +2898,13 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        *startop = PL_eval_root;
     } else
        SAVEFREEOP(PL_eval_root);
-    if (gimme & G_VOID)
+    if (gimme & G_VOID && ! PL_in_eval & EVAL_INREQUIRE)
+       /*
+        * EVAL_INREQUIRE (the code is being required) is special-cased :
+        * in this case we want scalar context to be forced, instead
+        * of void context, so a proper return value is returned from
+        * C<require> via this leaveeval op.
+        */
        scalarvoid(PL_eval_root);
     else if (gimme & G_ARRAY)
        list(PL_eval_root);