[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 (file)
--- 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 (executable)
--- 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 (file)
--- 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;
        }
     }