From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sun, 28 May 2000 07:02:50 +0000 (+0000)
Subject: call_method(...,G_EVAL) can longjmp() out if the method probing
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=968b39461011b9bd1e503c77c95c2eeec281b946;p=p5sagit%2Fp5-mst-13.2.git

call_method(...,G_EVAL) can longjmp() out if the method probing
failed (from Gisle Aas)

p4raw-id: //depot/perl@6127
---

diff --git a/cop.h b/cop.h
index e588675..3b3c3ed 100644
--- a/cop.h
+++ b/cop.h
@@ -423,6 +423,7 @@ L<perlcall>.
 #define G_NOARGS	8	/* Don't construct a @_ array. */
 #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. */
 
 /* flag bits for PL_in_eval */
 #define EVAL_NULL	0	/* not in an eval */
diff --git a/perl.c b/perl.c
index acf3bd8..7564282 100644
--- a/perl.c
+++ b/perl.c
@@ -1570,18 +1570,7 @@ Perl_call_method(pTHX_ const char *methname, I32 flags)
                		/* name of the subroutine */
           		/* See G_* flags in cop.h */
 {
-    dSP;
-    OP myop;
-    if (!PL_op) {
-	Zero(&myop, 1, OP);
-	PL_op = &myop;
-    }
-    XPUSHs(sv_2mortal(newSVpv(methname,0)));
-    PUTBACK;
-    pp_method();
-    if (PL_op == &myop)
-	PL_op = Nullop;
-    return call_sv(*PL_stack_sp--, flags);
+    return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD);
 }
 
 /* May be called with any of a CV, a GV, or an SV containing the name. */
@@ -1601,6 +1590,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 {
     dSP;
     LOGOP myop;		/* fake syntax tree node */
+    UNOP method_op;
     I32 oldmark;
     I32 retval;
     I32 oldscope;
@@ -1638,6 +1628,14 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	  && !(flags & G_NODEBUG))
 	PL_op->op_private |= OPpENTERSUB_DB;
 
+    if (flags & G_METHOD) {
+	Zero(&method_op, 1, UNOP);
+	method_op.op_next = PL_op;
+	method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
+	myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
+	PL_op = &method_op;
+    }
+
     if (!(flags & G_EVAL)) {
 	CATCH_SET(TRUE);
 	call_body((OP*)&myop, FALSE);
@@ -1655,7 +1653,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	    ENTER;
 	    SAVETMPS;
 	    
-	    push_return(PL_op->op_next);
+	    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. */