sv_clear can manipulate the arena array directly too.

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

diff --git a/pp_ctl.c b/pp_ctl.c
index 8a6c3e5..ed64242 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1490,56 +1490,6 @@ PP(pp_xor)
        RETSETNO;
 }
 
-PP(pp_andassign)
-{
-    dSP;
-    if (!SvTRUE(TOPs))
-       RETURN;
-    else
-       RETURNOP(cLOGOP->op_other);
-}
-
-PP(pp_orassign)
-{
-    dSP;
-    if (SvTRUE(TOPs))
-       RETURN;
-    else
-       RETURNOP(cLOGOP->op_other);
-}
-
-PP(pp_dorassign)
-{
-    dSP;
-    register SV* sv;
-
-    sv = TOPs;
-    if (!sv || !SvANY(sv)) {
-       RETURNOP(cLOGOP->op_other);
-    }
-
-    switch (SvTYPE(sv)) {
-    case SVt_PVAV:
-       if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-           RETURN;
-       break;
-    case SVt_PVHV:
-       if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-           RETURN;
-       break;
-    case SVt_PVCV:
-       if (CvROOT(sv) || CvXSUB(sv))
-           RETURN;
-       break;
-    default:
-       SvGETMAGIC(sv);
-       if (SvOK(sv))
-           RETURN;
-    }
-
-    RETURNOP(cLOGOP->op_other);
-}
-
 PP(pp_caller)
 {
     dSP;
@@ -1943,24 +1893,33 @@ PP(pp_return)
     SV *sv;
     OP *retop;
 
-    if (PL_curstackinfo->si_type == PERLSI_SORT) {
-       if (cxstack_ix == PL_sortcxix
-           || dopoptosub(cxstack_ix) <= PL_sortcxix)
-       {
-           if (cxstack_ix > PL_sortcxix)
-               dounwind(PL_sortcxix);
-           AvARRAY(PL_curstack)[1] = *SP;
+    cxix = dopoptosub(cxstack_ix);
+    if (cxix < 0) {
+       if (CxMULTICALL(cxstack)) { /* In this case we must be in a
+                                    * sort block, which is a CXt_NULL
+                                    * not a CXt_SUB */
+           dounwind(0);
+           PL_stack_base[1] = *PL_stack_sp;
            PL_stack_sp = PL_stack_base + 1;
            return 0;
        }
+       else
+           DIE(aTHX_ "Can't return outside a subroutine");
     }
-
-    cxix = dopoptosub(cxstack_ix);
-    if (cxix < 0)
-       DIE(aTHX_ "Can't return outside a subroutine");
     if (cxix < cxstack_ix)
        dounwind(cxix);
 
+    if (CxMULTICALL(&cxstack[cxix])) {
+       gimme = cxstack[cxix].blk_gimme;
+       if (gimme == G_VOID)
+           PL_stack_sp = PL_stack_base;
+       else if (gimme == G_SCALAR) {
+           PL_stack_base[1] = *PL_stack_sp;
+           PL_stack_sp = PL_stack_base + 1;
+       }
+       return 0;
+    }
+
     POPBLOCK(cx,newpm);
     switch (CxTYPE(cx)) {
     case CXt_SUB:
@@ -2311,6 +2270,8 @@ PP(pp_goto)
                else
                    DIE(aTHX_ "Can't goto subroutine from an eval-block");
            }
+           else if (CxMULTICALL(cx))
+               DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");
            if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
                /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;
@@ -2523,7 +2484,7 @@ PP(pp_goto)
                    gotoprobe = PL_main_root;
                break;
            case CXt_SUB:
-               if (CvDEPTH(cx->blk_sub.cv)) {
+               if (CvDEPTH(cx->blk_sub.cv) && !CxMULTICALL(cx)) {
                    gotoprobe = CvROOT(cx->blk_sub.cv);
                    break;
                }
@@ -2755,6 +2716,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
 /* startop op_free() this to undo. */
 /* code Short string id of the caller. */
 {
+    /* FIXME - how much of this code is common with pp_entereval?  */
     dVAR; dSP;                         /* Make POPBLOCK work. */
     PERL_CONTEXT *cx;
     SV **newsp;
@@ -2767,6 +2729,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     char *safestr;
     int runtime;
     CV* runcv = Nullcv;        /* initialise to avoid compiler warnings */
+    STRLEN len;
 
     ENTER;
     lex_start(sv);
@@ -2795,8 +2758,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
        (i.e. before run-time proper). To work around the coredump that
        ensues, we always turn GvMULTI_on for any globals that were
        introduced within evals. See force_ident(). GSAR 96-10-12 */
-    safestr = savepv(tmpbuf);
-    SAVEDELETE(PL_defstash, safestr, strlen(safestr));
+    len = strlen(tmpbuf);
+    safestr = savepvn(tmpbuf, len);
+    SAVEDELETE(PL_defstash, safestr, len);
     SAVEHINTS();
 #ifdef OP_IN_REGISTER
     PL_opsave = op;
@@ -3350,7 +3314,7 @@ PP(pp_require)
        SETERRNO(0, SS_NORMAL);
 
     /* Assume success here to prevent recursive requirement. */
-    len = strlen(name);
+    /* name is never assigned to again, so len is still strlen(name)  */
     /* Check whether a hook in @INC has already filled %INC */
     if (!hook_sv) {
        (void)hv_store(GvHVn(PL_incgv), name, len, newSVpv(CopFILE(&PL_compiling),0),0);
@@ -3426,7 +3390,7 @@ PP(pp_entereval)
     CV* runcv;
     U32 seq;
 
-    if (!SvPV_const(sv,len))
+    if (!SvPV_nolen_const(sv))
        RETPUSHUNDEF;
     TAINT_PROPER("eval");
 
@@ -3454,8 +3418,9 @@ PP(pp_entereval)
        (i.e. before run-time proper). To work around the coredump that
        ensues, we always turn GvMULTI_on for any globals that were
        introduced within evals. See force_ident(). GSAR 96-10-12 */
-    safestr = savepv(tmpbuf);
-    SAVEDELETE(PL_defstash, safestr, strlen(safestr));
+    len = strlen(tmpbuf);
+    safestr = savepvn(tmpbuf, len);
+    SAVEDELETE(PL_defstash, safestr, len);
     SAVEHINTS();
     PL_hints = PL_op->op_targ;
     SAVESPTR(PL_compiling.cop_warnings);