Merge the cut & paste code from Perl_call_sv/Perl_fold_constants with

the near identical code in pp_entertry into Perl_create_eval_scope.
Move the cut & paste code from Perl_call_sv/Perl_fold_constants into
Perl_delete_eval_scope.

p4raw-id: //depot/perl@27617

diff --git a/cop.h b/cop.h
index ef92d8e..359a427 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -646,6 +646,8 @@ L<perlcall>.
 #define G_KEEPERR      16      /* Append errors to $@, don't overwrite it */
 #define G_NODEBUG      32      /* Disable debugging at toplevel.  */
 #define G_METHOD       64       /* Calling method. */
+#define G_FAKINGEVAL  256      /* Faking en eval context for call_sv or
+                                  fold_constants. */
 
 /* flag bits for PL_in_eval */
 #define EVAL_NULL      0       /* not in an eval */

diff --git a/embed.fnc b/embed.fnc
index a124e20..d74193e 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -129,6 +129,7 @@ ApR |UV     |cast_uv        |NV f
 ApR    |I32    |my_chsize      |int fd|Off_t length
 #endif
 pR     |OP*    |convert        |I32 optype|I32 flags|NULLOK OP* o
+pM     |PERL_CONTEXT*  |create_eval_scope|U32 flags
 : croak()'s first parm can be NULL.  Otherwise, mod_perl breaks.
 Afprd  |void   |croak          |NULLOK const char* pat|...
 Apr    |void   |vcroak         |NN const char* pat|NULLOK va_list* args
@@ -173,6 +174,7 @@ Ap  |I32    |debstack
 Ap     |I32    |debstackptrs
 Ap     |char*  |delimcpy       |NN char* to|NN const char* toend|NN const char* from \
                                |NN const char* fromend|int delim|NN I32* retlen
+pM     |void   |delete_eval_scope
 p      |void   |deprecate      |NN const char* s
 p      |void   |deprecate_old  |NN const char* s
 Afp    |OP*    |die            |NULLOK const char* pat|...

diff --git a/embed.h b/embed.h
index 93dda39..d6b9bfa 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -94,6 +94,7 @@
 #endif
 #ifdef PERL_CORE
 #define convert                        Perl_convert
+#define create_eval_scope      Perl_create_eval_scope
 #endif
 #define croak                  Perl_croak
 #define vcroak                 Perl_vcroak
@@ -146,6 +147,7 @@
 #define debstackptrs           Perl_debstackptrs
 #define delimcpy               Perl_delimcpy
 #ifdef PERL_CORE
+#define delete_eval_scope      Perl_delete_eval_scope
 #define deprecate              Perl_deprecate
 #define deprecate_old          Perl_deprecate_old
 #endif
@@ -2272,6 +2274,7 @@
 #endif
 #ifdef PERL_CORE
 #define convert(a,b,c)         Perl_convert(aTHX_ a,b,c)
+#define create_eval_scope(a)   Perl_create_eval_scope(aTHX_ a)
 #endif
 #define vcroak(a,b)            Perl_vcroak(aTHX_ a,b)
 #if defined(PERL_IMPLICIT_CONTEXT)
@@ -2307,6 +2310,7 @@
 #define debstackptrs()         Perl_debstackptrs(aTHX)
 #define delimcpy(a,b,c,d,e,f)  Perl_delimcpy(aTHX_ a,b,c,d,e,f)
 #ifdef PERL_CORE
+#define delete_eval_scope()    Perl_delete_eval_scope(aTHX)
 #define deprecate(a)           Perl_deprecate(aTHX_ a)
 #define deprecate_old(a)       Perl_deprecate_old(aTHX_ a)
 #endif

diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index dcd868f..9a69030 100644 (file)
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -117,7 +117,7 @@ use Getopt::Std;
 use Carp;
 use Test::More tests => ( # per-pkg tests (function ct + require_ok)
                          40 + 16       # Data::Dumper, Digest::MD5
-                         + 511 + 234   # B::Deparse, B
+                         + 511 + 235   # B::Deparse, B
                          + 588 + 189   # POSIX, IO::Socket
                          + 3 * ($] > 5.009)
                          + 14 * ($] >= 5.009003)

diff --git a/op.c b/op.c
index 1fd94c2..ef05f5b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2183,22 +2183,8 @@ Perl_fold_constants(pTHX_ register OP *o)
     PL_op = curop;
 
     oldscope = PL_scopestack_ix;
+    create_eval_scope(G_FAKINGEVAL);
 
-       /* we're trying to emulate pp_entertry() here */
-       {
-           register PERL_CONTEXT *cx;
-           const I32 gimme = GIMME_V;
-       
-           ENTER;
-           SAVETMPS;
-       
-           PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
-           PUSHEVAL(cx, 0, 0);
-           PL_eval_root = PL_op;             /* Only needed so that goto works right. */
-       
-           PL_in_eval = EVAL_INEVAL;
-           sv_setpvn(ERRSV,"",0);
-       }
     JMPENV_PUSH(ret);
 
     switch (ret) {
@@ -2225,21 +2211,9 @@ Perl_fold_constants(pTHX_ register OP *o)
     }
 
     JMPENV_POP;
-    if (PL_scopestack_ix > oldscope) {
-       SV **newsp;
-       PMOP *newpm;
-       I32 gimme;
-       register PERL_CONTEXT *cx;
-       I32 optype;
-       
-       POPBLOCK(cx,newpm);
-           POPEVAL(cx);
-           PL_curpm = newpm;
-           LEAVE;
-           PERL_UNUSED_VAR(newsp);
-           PERL_UNUSED_VAR(gimme);
-           PERL_UNUSED_VAR(optype);
-    }
+
+    if (PL_scopestack_ix > oldscope)
+       delete_eval_scope();
 
     if (ret)
        goto nope;

diff --git a/perl.c b/perl.c
index a98314b..7e0f842 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2604,27 +2604,11 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
     else {
        myop.op_other = (OP*)&myop;
        PL_markstack_ptr--;
-       /* we're trying to emulate pp_entertry() here */
-       {
-           register PERL_CONTEXT *cx;
-           const I32 gimme = GIMME_V;
-       
-           ENTER;
-           SAVETMPS;
-       
-           PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
-           PUSHEVAL(cx, 0, 0);
-           PL_eval_root = PL_op;             /* Only needed so that goto works right. */
-       
-           PL_in_eval = EVAL_INEVAL;
-           if (flags & G_KEEPERR)
-               PL_in_eval |= EVAL_KEEPERR;
-           else
-               sv_setpvn(ERRSV,"",0);
-       }
+       create_eval_scope(flags|G_FAKINGEVAL);
        PL_markstack_ptr++;
 
        JMPENV_PUSH(ret);
+
        switch (ret) {
        case 0:
  redo_body:
@@ -2661,21 +2645,8 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
            break;
        }
 
-       if (PL_scopestack_ix > oldscope) {
-           SV **newsp;
-           PMOP *newpm;
-           I32 gimme;
-           register PERL_CONTEXT *cx;
-           I32 optype;
-
-           POPBLOCK(cx,newpm);
-           POPEVAL(cx);
-           PL_curpm = newpm;
-           LEAVE;
-           PERL_UNUSED_VAR(newsp);
-           PERL_UNUSED_VAR(gimme);
-           PERL_UNUSED_VAR(optype);
-       }
+       if (PL_scopestack_ix > oldscope)
+           delete_eval_scope();
        JMPENV_POP;
     }
 

diff --git a/pp_ctl.c b/pp_ctl.c
index 87a383d..c0e3a09 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3562,22 +3562,57 @@ PP(pp_leaveeval)
     RETURNOP(retop);
 }
 
-PP(pp_entertry)
+/* Common code for Perl_call_sv and Perl_fold_constants, put here to keep it
+   close to the related Perl_create_eval_scope.  */
+void
+Perl_delete_eval_scope(pTHX)
 {
-    dVAR; dSP;
+    SV **newsp;
+    PMOP *newpm;
+    I32 gimme;
     register PERL_CONTEXT *cx;
-    const I32 gimme = GIMME_V;
+    I32 optype;
+       
+    POPBLOCK(cx,newpm);
+    POPEVAL(cx);
+    PL_curpm = newpm;
+    LEAVE;
+    PERL_UNUSED_VAR(newsp);
+    PERL_UNUSED_VAR(gimme);
+    PERL_UNUSED_VAR(optype);
+}
 
+/* Common-ish code salvaged from Perl_call_sv and pp_entertry, because it was
+   also needed by Perl_fold_constants.  */
+PERL_CONTEXT *
+Perl_create_eval_scope(pTHX_ U32 flags)
+{
+    PERL_CONTEXT *cx;
+    const I32 gimme = GIMME_V;
+       
     ENTER;
     SAVETMPS;
 
-    PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), SP);
+    PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
     PUSHEVAL(cx, 0, 0);
-    cx->blk_eval.retop = cLOGOP->op_other->op_next;
+    PL_eval_root = PL_op;      /* Only needed so that goto works right. */
 
     PL_in_eval = EVAL_INEVAL;
-    sv_setpvn(ERRSV,"",0);
-    PUTBACK;
+    if (flags & G_KEEPERR)
+       PL_in_eval |= EVAL_KEEPERR;
+    else
+       sv_setpvn(ERRSV,"",0);
+    if (flags & G_FAKINGEVAL) {
+       PL_eval_root = PL_op; /* Only needed so that goto works right. */
+    }
+    return cx;
+}
+    
+PP(pp_entertry)
+{
+    dVAR;
+    PERL_CONTEXT *cx = create_eval_scope(0);
+    cx->blk_eval.retop = cLOGOP->op_other->op_next;
     return DOCATCH(PL_op->op_next);
 }
 

diff --git a/proto.h b/proto.h
index eb996cb..528bcf6 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -224,6 +224,7 @@ PERL_CALLCONV I32   Perl_my_chsize(pTHX_ int fd, Off_t length)
 PERL_CALLCONV OP*      Perl_convert(pTHX_ I32 optype, I32 flags, OP* o)
                        __attribute__warn_unused_result__;
 
+PERL_CALLCONV PERL_CONTEXT*    Perl_create_eval_scope(pTHX_ U32 flags);
 PERL_CALLCONV void     Perl_croak(pTHX_ const char* pat, ...)
                        __attribute__noreturn__
                        __attribute__format__(__printf__,pTHX_1,pTHX_2);
@@ -373,6 +374,7 @@ PERL_CALLCONV char* Perl_delimcpy(pTHX_ char* to, const char* toend, const char*
                        __attribute__nonnull__(pTHX_4)
                        __attribute__nonnull__(pTHX_6);
 
+PERL_CALLCONV void     Perl_delete_eval_scope(pTHX);
 PERL_CALLCONV void     Perl_deprecate(pTHX_ const char* s)
                        __attribute__nonnull__(pTHX_1);