Make readline() default to *ARGV.

Plus MAD fixes.

p4raw-id: //depot/perl@30750

diff --git a/embed.fnc b/embed.fnc
index e985d6a..0c856ad 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1174,6 +1174,7 @@ pR        |OP*    |ck_match       |NN OP *o
 pR     |OP*    |ck_method      |NN OP *o
 pR     |OP*    |ck_null        |NN OP *o
 pR     |OP*    |ck_open        |NN OP *o
+pR     |OP*    |ck_readline    |NN OP *o
 pR     |OP*    |ck_repeat      |NN OP *o
 pR     |OP*    |ck_require     |NN OP *o
 pR     |OP*    |ck_retarget    |NN OP *o

diff --git a/embed.h b/embed.h
index 374ac87..2f7cb14 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1171,6 +1171,7 @@
 #define ck_method              Perl_ck_method
 #define ck_null                        Perl_ck_null
 #define ck_open                        Perl_ck_open
+#define ck_readline            Perl_ck_readline
 #define ck_repeat              Perl_ck_repeat
 #define ck_require             Perl_ck_require
 #define ck_retarget            Perl_ck_retarget
@@ -1895,6 +1896,7 @@
 #define ck_method              Perl_ck_method
 #define ck_null                        Perl_ck_null
 #define ck_open                        Perl_ck_open
+#define ck_readline            Perl_ck_readline
 #define ck_repeat              Perl_ck_repeat
 #define ck_require             Perl_ck_require
 #define ck_return              Perl_ck_return
@@ -3398,6 +3400,7 @@
 #define ck_method(a)           Perl_ck_method(aTHX_ a)
 #define ck_null(a)             Perl_ck_null(aTHX_ a)
 #define ck_open(a)             Perl_ck_open(aTHX_ a)
+#define ck_readline(a)         Perl_ck_readline(aTHX_ a)
 #define ck_repeat(a)           Perl_ck_repeat(aTHX_ a)
 #define ck_require(a)          Perl_ck_require(aTHX_ a)
 #define ck_retarget(a)         Perl_ck_retarget(aTHX_ a)
@@ -4133,6 +4136,7 @@
 #define ck_method(a)           Perl_ck_method(aTHX_ a)
 #define ck_null(a)             Perl_ck_null(aTHX_ a)
 #define ck_open(a)             Perl_ck_open(aTHX_ a)
+#define ck_readline(a)         Perl_ck_readline(aTHX_ a)
 #define ck_repeat(a)           Perl_ck_repeat(aTHX_ a)
 #define ck_require(a)          Perl_ck_require(aTHX_ a)
 #define ck_return(a)           Perl_ck_return(aTHX_ a)

diff --git a/op.c b/op.c
index 48437cf..23b4b81 100644 (file)
--- a/op.c
+++ b/op.c
@@ -6725,6 +6725,22 @@ Perl_ck_defined(pTHX_ OP *o)             /* 19990527 MJD */
 }
 
 OP *
+Perl_ck_readline(pTHX_ OP *o)
+{
+    if (!(o->op_flags & OPf_KIDS)) {
+       OP * const newop
+           = newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, PL_argvgv));
+#ifdef PERL_MAD
+       op_getmad(o,newop,'O');
+#else
+       op_free(o);
+#endif
+       return newop;
+    }
+    return o;
+}
+
+OP *
 Perl_ck_rfun(pTHX_ OP *o)
 {
     const OPCODE type = o->op_type;
@@ -6910,8 +6926,13 @@ Perl_ck_open(pTHX_ OP *o)
     }
     if (o->op_type == OP_BACKTICK) {
        if (!(o->op_flags & OPf_KIDS)) {
+           OP * const newop = newUNOP(OP_BACKTICK, 0, newDEFSVOP());
+#ifdef PERL_MAD
+           op_getmad(o,newop,'O');
+#else
            op_free(o);
-           return newUNOP(OP_BACKTICK, 0, newDEFSVOP());
+#endif
+           return newop;
        }
        return o;
     }

diff --git a/opcode.h b/opcode.h
index 7acce19..00dde1a 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -1187,7 +1187,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        MEMBER_TO_FPTR(Perl_ck_fun),    /* bless */
        MEMBER_TO_FPTR(Perl_ck_open),   /* backtick */
        MEMBER_TO_FPTR(Perl_ck_glob),   /* glob */
-       MEMBER_TO_FPTR(Perl_ck_null),   /* readline */
+       MEMBER_TO_FPTR(Perl_ck_readline),       /* readline */
        MEMBER_TO_FPTR(Perl_ck_null),   /* rcatline */
        MEMBER_TO_FPTR(Perl_ck_fun),    /* regcmaybe */
        MEMBER_TO_FPTR(Perl_ck_fun),    /* regcreset */

diff --git a/opcode.pl b/opcode.pl
index d2602a2..3897ab1 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -597,7 +597,7 @@ bless               bless                   ck_fun          s@      S S?
 backtick       quoted execution (``, qx)       ck_open         tu%     S?
 # glob defaults its first arg to $_
 glob           glob                    ck_glob         t@      S?
-readline       <HANDLE>                ck_null         t%      F?
+readline       <HANDLE>                ck_readline     t%      F?
 rcatline       append I/O operator     ck_null         t$
 
 # Bindable operators.

diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index ab02136..1395631 100644 (file)
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -4259,14 +4259,17 @@ C<chdir> there, it would have been testing the wrong file.
     closedir DIR;
 
 =item readline EXPR
+
+=item readline
 X<readline> X<gets> X<fgets>
 
-Reads from the filehandle whose typeglob is contained in EXPR.  In scalar
-context, each call reads and returns the next line, until end-of-file is
-reached, whereupon the subsequent call returns undef.  In list context,
-reads until end-of-file is reached and returns a list of lines.  Note that
-the notion of "line" used here is however you may have defined it
-with C<$/> or C<$INPUT_RECORD_SEPARATOR>).  See L<perlvar/"$/">.
+Reads from the filehandle whose typeglob is contained in EXPR (or from
+*ARGV if EXPR is not provided).  In scalar context, each call reads and
+returns the next line, until end-of-file is reached, whereupon the
+subsequent call returns undef.  In list context, reads until end-of-file
+is reached and returns a list of lines.  Note that the notion of "line"
+used here is however you may have defined it with C<$/> or
+C<$INPUT_RECORD_SEPARATOR>).  See L<perlvar/"$/">.
 
 When C<$/> is set to C<undef>, when readline() is in scalar
 context (i.e. file slurp mode), and when an empty file is read, it

diff --git a/pp.sym b/pp.sym
index 428fc30..66df9e1 100644 (file)
--- a/pp.sym
+++ b/pp.sym
@@ -30,6 +30,7 @@ Perl_ck_match
 Perl_ck_method
 Perl_ck_null
 Perl_ck_open
+Perl_ck_readline
 Perl_ck_repeat
 Perl_ck_require
 Perl_ck_return

diff --git a/pp_proto.h b/pp_proto.h
index 1df3af7..e5c87bd 100644 (file)
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -29,6 +29,7 @@ PERL_CKDEF(Perl_ck_match)
 PERL_CKDEF(Perl_ck_method)
 PERL_CKDEF(Perl_ck_null)
 PERL_CKDEF(Perl_ck_open)
+PERL_CKDEF(Perl_ck_readline)
 PERL_CKDEF(Perl_ck_repeat)
 PERL_CKDEF(Perl_ck_require)
 PERL_CKDEF(Perl_ck_return)

diff --git a/proto.h b/proto.h
index 0fc070e..85aa884 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3159,6 +3159,10 @@ PERL_CALLCONV OP*        Perl_ck_open(pTHX_ OP *o)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
 
+PERL_CALLCONV OP*      Perl_ck_readline(pTHX_ OP *o)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_1);
+
 PERL_CALLCONV OP*      Perl_ck_repeat(pTHX_ OP *o)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);

diff --git a/t/op/readline.t b/t/op/readline.t
index 394acdb..0d6598f 100644 (file)
--- a/t/op/readline.t
+++ b/t/op/readline.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 17;
+plan tests => 18;
 
 eval { for (\2) { $_ = <FH> } };
 like($@, 'Modification of a read-only value attempted', '[perl #19566]');
@@ -83,6 +83,10 @@ fresh_perl_is('BEGIN{<>}', '',
               { switches => ['-w'], stdin => '', stderr => 1 },
               'No ARGVOUT used only once warning');
 
+fresh_perl_is('print readline', 'foo',
+              { switches => ['-w'], stdin => 'foo', stderr => 1 },
+              'readline() defaults to *ARGV');
+
 my $obj = bless [];
 $obj .= <DATA>;
 like($obj, qr/main=ARRAY.*world/, 'rcatline and refs');