Change 14260 by jhi@alpha on 2002/01/15 01:23:53
Subject: [PATCH] Overriding readline() should also override <FH>
From: Rafael Garcia-Suarez <[EMAIL PROTECTED]>
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 <[EMAIL PROTECTED]>
Date: Mon, 14 Jan 2002 23:18:43 +0100
Message-ID: <20020114231843.E691@rafael>
Affected files ...
.... //depot/perl/pod/perlsub.pod#41 edit
.... //depot/perl/t/op/override.t#4 edit
.... //depot/perl/toke.c#410 edit
Differences ...
==== //depot/perl/pod/perlsub.pod#41 (text) ====
Index: perl/pod/perlsub.pod
--- perl/pod/perlsub.pod.~1~ Mon Jan 14 18:30:06 2002
+++ perl/pod/perlsub.pod Mon Jan 14 18:30:06 2002
@@ -1223,6 +1223,9 @@
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
==== //depot/perl/t/op/override.t#4 (xtext) ====
Index: perl/t/op/override.t
--- perl/t/op/override.t.~1~ Mon Jan 14 18:30:06 2002
+++ perl/t/op/override.t Mon Jan 14 18:30:06 2002
@@ -6,7 +6,7 @@
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 "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";
==== //depot/perl/toke.c#410 (text) ====
Index: perl/toke.c
--- perl/toke.c.~1~ Mon Jan 14 18:30:06 2002
+++ perl/toke.c Mon Jan 14 18:30:06 2002
@@ -6661,6 +6661,9 @@
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 @@
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 @@
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 @@
? (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 @@
(<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;
}
}
End of Patch.
