From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Mon, 14 Jan 2002 23:03:04 +0000 (+0100)
Subject: [PATCH] Overriding readline() should also override <FH>
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9b3023bc082e94b9899c0042ba030062098682a6;p=p5sagit%2Fp5-mst-13.2.git

[PATCH] Overriding readline() should also override <FH>
Date: Mon, 14 Jan 2002 23:03:04 +0100
Message-ID: <20020114230304.A691@rafael>

Subject: Re: [PATCH] Overriding readline() should also override <FH>
From: Rafael Garcia-Suarez <rgarciasuarez@free.fr>
Date: Mon, 14 Jan 2002 23:18:43 +0100
Message-ID: <20020114231843.E691@rafael>

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

diff --git a/pod/perlsub.pod b/pod/perlsub.pod
index a1bba6e..8ec39e3 100644
--- a/pod/perlsub.pod
+++ b/pod/perlsub.pod
@@ -1223,6 +1223,9 @@ the argument C<"Foo/Bar.pm"> in @_.  See L<perlfunc/require>.
 And, as you'll have noticed from the previous example, if you override
 C<glob>, the C<E<lt>*E<gt>> glob operator is overridden as well.
 
+In a similar fashion, overriding the C<readline> function also overrides
+the equivalent I/O operator C<< <FILEHANDLE> >>.
+
 Finally, some built-ins (e.g. C<exists> or C<grep>) can't be overridden.
 
 =head2 Autoloading
diff --git a/t/op/override.t b/t/op/override.t
index 590fcaa..1a4e5e0 100755
--- a/t/op/override.t
+++ b/t/op/override.t
@@ -6,7 +6,7 @@ BEGIN {
     push @INC, '../lib';
 }
 
-print "1..11\n";
+print "1..17\n";
 
 #
 # This file tries to test builtin override using CORE::GLOBAL
@@ -70,3 +70,21 @@ print "ok 10\n";
     print "not " if $r or $@ !~ /^Can't locate NoNeXiSt/i;
     print "ok 11\n";
 }
+
+#
+# readline() has special behaviour too
+#
+
+$r = 11;
+BEGIN { *CORE::GLOBAL::readline = sub (;*) { ++$r }; }
+print <FH>	== 12 ? "ok 12\n" : "not ok 12\n";
+print <$fh>	== 13 ? "ok 13\n" : "not ok 13\n";
+my $pad_fh;
+print <$pad_fh>	== 14 ? "ok 14\n" : "not ok 14\n";
+
+# Non-global readline() override
+BEGIN { *Rgs::readline = sub (;*) { --$r }; }
+package Rgs;
+print <FH>	== 13 ? "ok 15\n" : "not ok 15\n";
+print <$fh>	== 12 ? "ok 16\n" : "not ok 16\n";
+print <$pad_fh>	== 11 ? "ok 17\n" : "not ok 17\n";
diff --git a/toke.c b/toke.c
index 8382333..1445ee3 100644
--- a/toke.c
+++ b/toke.c
@@ -6661,6 +6661,9 @@ S_scan_inputsymbol(pTHX_ char *start)
 	return s;
     }
     else {
+	bool readline_overriden = FALSE;
+	GV *gv_readline = Nullgv;
+	GV **gvp;
     	/* we're in a filehandle read situation */
 	d = PL_tokenbuf;
 
@@ -6668,6 +6671,15 @@ S_scan_inputsymbol(pTHX_ char *start)
 	if (!len)
 	    (void)strcpy(d,"ARGV");
 
+	/* Check whether readline() is overriden */
+	if ((gv_readline = gv_fetchpv("readline", FALSE, SVt_PVCV))
+		&& GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)
+		||
+		(gvp = (GV**)hv_fetch(PL_globalstash, "readline", 8, FALSE))
+		&& (gv_readline = *gvp) != (GV*)&PL_sv_undef
+		&& GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
+	    readline_overriden = TRUE;
+
 	/* if <$fh>, create the ops to turn the variable into a
 	   filehandle
 	*/
@@ -6689,7 +6701,11 @@ S_scan_inputsymbol(pTHX_ char *start)
 		else {
 		    OP *o = newOP(OP_PADSV, 0);
 		    o->op_targ = tmp;
-		    PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
+		    PL_lex_op = readline_overriden
+			? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST, o,
+				    newCVREF(0, newGVOP(OP_GV,0,gv_readline))))
+			: (OP*)newUNOP(OP_READLINE, 0, o);
 		}
 	    }
 	    else {
@@ -6701,9 +6717,14 @@ intro_sym:
 				 ? (GV_ADDMULTI | GV_ADDINEVAL)
 				 : GV_ADDMULTI),
 				SVt_PV);
-		PL_lex_op = (OP*)newUNOP(OP_READLINE, 0,
-					    newUNOP(OP_RV2SV, 0,
-						newGVOP(OP_GV, 0, gv)));
+		PL_lex_op = readline_overriden
+		    ? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
+			    append_elem(OP_LIST,
+				newUNOP(OP_RV2SV, 0, newGVOP(OP_GV, 0, gv)),
+				newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
+		    : (OP*)newUNOP(OP_READLINE, 0,
+			    newUNOP(OP_RV2SV, 0,
+				newGVOP(OP_GV, 0, gv)));
 	    }
 	    PL_lex_op->op_flags |= OPf_SPECIAL;
 	    /* we created the ops in PL_lex_op, so make yylval.ival a null op */
@@ -6714,7 +6735,12 @@ intro_sym:
 	   (<Foo::BAR> or <FOO>) so build a simple readline OP */
 	else {
 	    GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
-	    PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
+	    PL_lex_op = readline_overriden
+		? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
+			append_elem(OP_LIST,
+			    newGVOP(OP_GV, 0, gv),
+			    newCVREF(0, newGVOP(OP_GV, 0, gv_readline))))
+		: (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
 	    yylval.ival = OP_NULL;
 	}
     }