From: Nicholas Clark <nick@ccl4.org>
Date: Sun, 13 Jun 2010 10:38:16 +0000 (+0200)
Subject: Add a gimme parameter to S_tied_handle_method().
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0240605ecd7a040cc6058409c65a3ebc6b7d489b;p=p5sagit%2Fp5-mst-13.2.git

Add a gimme parameter to S_tied_handle_method().

This allows "GETC" to use it.
---

diff --git a/embed.fnc b/embed.fnc
index b1346fb..582e860 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1718,7 +1718,7 @@ sR	|int	|dooneliner	|NN const char *cmd|NN const char *filename
 s	|SV *	|space_join_names_mortal|NN char *const *array
 so	|OP *	|tied_handle_method|NN const char *const methname|NN SV **sp \
 				|NN IO *const io|NN MAGIC *const mg \
-				|unsigned int argc|...
+				|const U32 gimme|unsigned int argc|...
 #endif
 
 #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT)
diff --git a/pp_sys.c b/pp_sys.c
index 0d8673a..f9112ff 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -554,7 +554,8 @@ PP(pp_open)
 
 static OP *
 S_tied_handle_method(pTHX_ const char *const methname, SV **sp,
-		     IO *const io, MAGIC *const mg, unsigned int argc, ...)
+		     IO *const io, MAGIC *const mg, const U32 gimme,
+		     unsigned int argc, ...)
 {
     PERL_ARGS_ASSERT_TIED_HANDLE_METHOD;
 
@@ -572,17 +573,17 @@ S_tied_handle_method(pTHX_ const char *const methname, SV **sp,
 
     PUTBACK;
     ENTER_with_name("call_tied_handle_method");
-    call_method(methname, G_SCALAR);
+    call_method(methname, gimme);
     LEAVE_with_name("call_tied_handle_method");
     return NORMAL;
 }
 
 #define tied_handle_method(a,b,c,d)		\
-    S_tied_handle_method(aTHX_ a,b,c,d,0)
+    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,0)
 #define tied_handle_method1(a,b,c,d,e)	\
-    S_tied_handle_method(aTHX_ a,b,c,d,1,e)
+    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,1,e)
 #define tied_handle_method2(a,b,c,d,e,f)	\
-    S_tied_handle_method(aTHX_ a,b,c,d,2,e,f)
+    S_tied_handle_method(aTHX_ a,b,c,d,G_SCALAR,2,e,f)
 
 PP(pp_close)
 {
@@ -750,7 +751,7 @@ PP(pp_binmode)
 	       function, which I don't think that the optimiser will be able to
 	       figure out. Although, as it's a static function, in theory it
 	       could.  */
-	    return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg,
+	    return S_tied_handle_method(aTHX_ "BINMODE", SP, io, mg, G_SCALAR,
 					discp ? 1 : 0, discp);
 	}
     }
@@ -1215,17 +1216,13 @@ PP(pp_getc)
     if (gv && (io = GvIO(gv))) {
 	MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
 	if (mg) {
-	    const I32 gimme = GIMME_V;
-	    PUSHMARK(SP);
-	    PUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-	    PUTBACK;
-	    ENTER;
-	    call_method("GETC", gimme);
-	    LEAVE;
-	    SPAGAIN;
-	    if (gimme == G_SCALAR)
+	    const U32 gimme = GIMME_V;
+	    S_tied_handle_method(aTHX_ "GETC", SP, io, mg, gimme, 0);
+	    if (gimme == G_SCALAR) {
+		SPAGAIN;
 		SvSetMagicSV_nosteal(TARG, TOPs);
-	    RETURN;
+	    }
+	    return NORMAL;
 	}
     }
     if (!gv || do_eof(gv)) { /* make sure we have fp with something */
diff --git a/proto.h b/proto.h
index 714b3c9..3ab407e 100644
--- a/proto.h
+++ b/proto.h
@@ -5350,7 +5350,7 @@ STATIC SV *	S_space_join_names_mortal(pTHX_ char *const *array)
 #define PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL	\
 	assert(array)
 
-STATIC OP *	S_tied_handle_method(pTHX_ const char *const methname, SV **sp, IO *const io, MAGIC *const mg, unsigned int argc, ...)
+STATIC OP *	S_tied_handle_method(pTHX_ const char *const methname, SV **sp, IO *const io, MAGIC *const mg, const U32 gimme, unsigned int argc, ...)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2)
 			__attribute__nonnull__(pTHX_3)