Change 29924 by [EMAIL PROTECTED] on 2007/01/22 20:22:04
Integrate:
[ 27617]
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.
[ 29921]
Remove duplicate assignment to PL_eval_root in Perl_create_eval_scope
Affected files ...
... //depot/maint-5.8/perl/cop.h#26 integrate
... //depot/maint-5.8/perl/embed.fnc#178 integrate
... //depot/maint-5.8/perl/embed.h#133 integrate
... //depot/maint-5.8/perl/ext/B/t/concise-xs.t#9 integrate
... //depot/maint-5.8/perl/op.c#167 integrate
... //depot/maint-5.8/perl/perl.c#189 edit
... //depot/maint-5.8/perl/pp_ctl.c#148 edit
... //depot/maint-5.8/perl/proto.h#167 integrate
Differences ...
==== //depot/maint-5.8/perl/cop.h#26 (text) ====
Index: perl/cop.h
--- perl/cop.h#25~29888~ 2007-01-19 13:24:46.000000000 -0800
+++ perl/cop.h 2007-01-22 12:22:04.000000000 -0800
@@ -496,6 +496,8 @@
#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 */
==== //depot/maint-5.8/perl/embed.fnc#178 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#177~29919~ 2007-01-22 10:47:36.000000000 -0800
+++ perl/embed.fnc 2007-01-22 12:22:04.000000000 -0800
@@ -139,6 +139,7 @@
Ap |MAGIC* |condpair_magic |NN SV *sv
#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
@@ -183,6 +184,7 @@
Ap |I32 |debstackptrs
Ap |char* |delimcpy |NN char* to|NN char* toend|NN char* from \
|NN char* fromend|int delim|NN I32* retlen
+pM |void |delete_eval_scope
p |void |deprecate |NN char* s
p |void |deprecate_old |NN char* s
Afp |OP* |die |NULLOK const char* pat|...
==== //depot/maint-5.8/perl/embed.h#133 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#132~29919~ 2007-01-22 10:47:36.000000000 -0800
+++ perl/embed.h 2007-01-22 12:22:04.000000000 -0800
@@ -104,6 +104,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
@@ -156,6 +157,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
@@ -2205,6 +2207,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)
@@ -2240,6 +2243,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
==== //depot/maint-5.8/perl/ext/B/t/concise-xs.t#9 (text) ====
Index: perl/ext/B/t/concise-xs.t
--- perl/ext/B/t/concise-xs.t#8~29785~ 2007-01-13 08:56:44.000000000 -0800
+++ perl/ext/B/t/concise-xs.t 2007-01-22 12:22:04.000000000 -0800
@@ -94,7 +94,7 @@
use Carp;
use Test::More tests => ( 1 * !!$Config::Config{useithreads}
+ 0 * ($] > 5.009)
- + 786);
+ + 787);
require_ok("B::Concise");
==== //depot/maint-5.8/perl/op.c#167 (text) ====
Index: perl/op.c
--- perl/op.c#166~29913~ 2007-01-22 06:45:23.000000000 -0800
+++ perl/op.c 2007-01-22 12:22:04.000000000 -0800
@@ -2159,22 +2159,8 @@
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);
- }
#ifdef PERL_FLEXIBLE_EXCEPTIONS
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_runops));
@@ -2207,21 +2193,9 @@
}
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;
==== //depot/maint-5.8/perl/perl.c#189 (text) ====
Index: perl/perl.c
--- perl/perl.c#188~29913~ 2007-01-22 06:45:23.000000000 -0800
+++ perl/perl.c 2007-01-22 12:22:04.000000000 -0800
@@ -2719,25 +2719,8 @@
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;
-
- push_return(Nullop);
- 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);
- }
+ push_return(NULL);
+ create_eval_scope(flags|G_FAKINGEVAL);
PL_markstack_ptr++;
#ifdef PERL_FLEXIBLE_EXCEPTIONS
@@ -2747,6 +2730,7 @@
#else
JMPENV_PUSH(ret);
#endif
+
switch (ret) {
case 0:
#ifndef PERL_FLEXIBLE_EXCEPTIONS
@@ -2786,20 +2770,8 @@
}
if (PL_scopestack_ix > oldscope) {
- SV **newsp;
- PMOP *newpm;
- I32 gimme;
- register PERL_CONTEXT *cx;
- I32 optype;
-
- POPBLOCK(cx,newpm);
- POPEVAL(cx);
+ delete_eval_scope();
pop_return();
- PL_curpm = newpm;
- LEAVE;
- PERL_UNUSED_VAR(newsp);
- PERL_UNUSED_VAR(gimme);
- PERL_UNUSED_VAR(optype);
}
JMPENV_POP;
}
==== //depot/maint-5.8/perl/pp_ctl.c#148 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#147~29915~ 2007-01-22 07:49:59.000000000 -0800
+++ perl/pp_ctl.c 2007-01-22 12:22:04.000000000 -0800
@@ -3578,22 +3578,55 @@
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)
{
- 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;
- push_return(cLOGOP->op_other->op_next);
- PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), SP);
+ PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
PUSHEVAL(cx, 0, 0);
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)
+{
+ push_return(cLOGOP->op_other->op_next);
+ create_eval_scope(0);
return DOCATCH(PL_op->op_next);
}
==== //depot/maint-5.8/perl/proto.h#167 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#166~29919~ 2007-01-22 10:47:36.000000000 -0800
+++ perl/proto.h 2007-01-22 12:22:04.000000000 -0800
@@ -151,6 +151,7 @@
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);
@@ -254,6 +255,7 @@
PERL_CALLCONV I32 Perl_debstack(pTHX);
PERL_CALLCONV I32 Perl_debstackptrs(pTHX);
PERL_CALLCONV char* Perl_delimcpy(pTHX_ char* to, char* toend, char* from,
char* fromend, int delim, I32* retlen);
+PERL_CALLCONV void Perl_delete_eval_scope(pTHX);
PERL_CALLCONV void Perl_deprecate(pTHX_ char* s);
PERL_CALLCONV void Perl_deprecate_old(pTHX_ char* s);
PERL_CALLCONV OP* Perl_die(pTHX_ const char* pat, ...)
End of Patch.
