Revert change 23843.

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 69f499c..829b655 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,7 +1,7 @@
 /*    pp_ctl.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 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.
@@ -83,13 +83,40 @@ PP(pp_regcomp)
     STRLEN len;
     MAGIC *mg = Null(MAGIC*);
     
-    tmpstr = POPs;
-
     /* prevent recompiling under /o and ithreads. */
 #if defined(USE_ITHREADS)
-    if (pm->op_pmflags & PMf_KEEP && PM_GETRE(pm))
-        RETURN;
+    if (pm->op_pmflags & PMf_KEEP && PM_GETRE(pm)) {
+       if (PL_op->op_flags & OPf_STACKED) {
+           dMARK;
+           SP = MARK;
+       }
+       else
+           (void)POPs;
+       RETURN;
+    }
 #endif
+    if (PL_op->op_flags & OPf_STACKED) {
+       /* multiple args; concatentate them */
+       dMARK; dORIGMARK;
+       tmpstr = PAD_SV(ARGTARG);
+       sv_setpvn(tmpstr, "", 0);
+       while (++MARK <= SP) {
+           if (PL_amagic_generation) {
+               SV *sv;
+               if ((SvAMAGIC(tmpstr) || SvAMAGIC(*MARK)) &&
+                   (sv = amagic_call(tmpstr, *MARK, concat_amg, AMGf_assign)))
+               {
+                  sv_setsv(tmpstr, sv);
+                  continue;
+               }
+           }
+           sv_catsv(tmpstr, *MARK);
+       }
+       SvSETMAGIC(tmpstr);
+       SP = ORIGMARK;
+    }
+    else
+       tmpstr = POPs;
 
     if (SvROK(tmpstr)) {
        SV *sv = SvRV(tmpstr);
@@ -213,7 +240,7 @@ PP(pp_substcont)
            } else
 #endif
            {
-               (void)SvOOK_off(targ);
+               SvOOK_off(targ);
                if (SvLEN(targ))
                    Safefree(SvPVX(targ));
            }
@@ -2221,7 +2248,6 @@ PP(pp_goto)
     char *label;
     int do_dump = (PL_op->op_type == OP_DUMP);
     static char must_have_label[] = "goto must have label";
-    AV *oldav = Nullav;
 
     label = 0;
     if (PL_op->op_flags & OPf_STACKED) {
@@ -2236,6 +2262,7 @@ PP(pp_goto)
            SV** mark;
            I32 items = 0;
            I32 oldsave;
+           bool reified = 0;
 
        retry:
            if (!CvROOT(cv) && !CvXSUB(cv)) {
@@ -2277,16 +2304,16 @@ PP(pp_goto)
                Copy(AvARRAY(av), SP + 1, items, SV*);
                SvREFCNT_dec(GvAV(PL_defgv));
                GvAV(PL_defgv) = cx->blk_sub.savearray;
+               CLEAR_ARGARRAY(av);
                /* abandon @_ if it got reified */
                if (AvREAL(av)) {
-                   oldav = av; /* delay until return */
+                   reified = 1;
+                   SvREFCNT_dec(av);
                    av = newAV();
                    av_extend(av, items-1);
                    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;
@@ -2305,11 +2332,13 @@ PP(pp_goto)
 
            /* Now do some callish stuff. */
            SAVETMPS;
-           /* For reified @_, delay freeing till return from new sub */
-           if (oldav)
-               SAVEFREESV((SV*)oldav);
            SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
            if (CvXSUB(cv)) {
+               if (reified) {
+                   I32 index;
+                   for (index=0; index<items; index++)
+                       sv_2mortal(SP[-index]);
+               }
 #ifdef PERL_XSUB_OLDSTYLE
                if (CvOLDSTYLE(cv)) {
                    I32 (*fp3)(int,int,int);
@@ -2388,6 +2417,11 @@ PP(pp_goto)
                    Copy(mark,AvARRAY(av),items,SV*);
                    AvFILLp(av) = items - 1;
                    assert(!AvREAL(av));
+                   if (reified) {
+                       /* transfer 'ownership' of refcnts to new @_ */
+                       AvREAL_on(av);
+                       AvREIFY_off(av);
+                   }
                    while (items--) {
                        if (*mark)
                            SvTEMP_off(*mark);
@@ -2640,14 +2674,6 @@ S_save_lines(pTHX_ AV *array, SV *sv)
     }
 }
 
-#ifdef PERL_FLEXIBLE_EXCEPTIONS
-STATIC void *
-S_docatch_body(pTHX_ va_list args)
-{
-    return docatch_body();
-}
-#endif
-
 STATIC void *
 S_docatch_body(pTHX)
 {
@@ -2679,18 +2705,11 @@ S_docatch(pTHX_ OP *o)
     retop = cxstack[cxstack_ix].blk_eval.retop;
     cxstack[cxstack_ix].blk_eval.retop = Nullop;
 
-#ifdef PERL_FLEXIBLE_EXCEPTIONS
- redo_body:
-    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
-#else
     JMPENV_PUSH(ret);
-#endif
     switch (ret) {
     case 0:
-#ifndef PERL_FLEXIBLE_EXCEPTIONS
  redo_body:
        docatch_body();
-#endif
        break;
     case 3:
        /* die caught by an inner eval - continue inner loop */
@@ -3054,7 +3073,7 @@ PP(pp_require)
        if (!sv_derived_from(PL_patchlevel, "version"))
            (void *)upg_version(PL_patchlevel);
        if ( vcmp(sv,PL_patchlevel) > 0 )
-           DIE(aTHX_ "Perl v%_ required--this is only v%_, stopped",
+           DIE(aTHX_ "Perl v%"SVf" required--this is only v%"SVf", stopped",
                vstringify(sv), vstringify(PL_patchlevel));
 
            RETPUSHYES;
@@ -3907,3 +3926,13 @@ S_path_is_absolute(pTHX_ char *name)
     else
        return FALSE;
 }
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * vim: shiftwidth=4:
+*/