Make readline() default to *ARGV.

Plus MAD fixes.

p4raw-id: //depot/perl@30750

10 files changed, 49 insertions, 10 deletions

diff --git a/embed.fnc b/embed.fnc
index e985d6a1f4..0c856ad726 100644
--- 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 374ac8732a..2f7cb140d5 100644
--- 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 48437cfccb..23b4b81863 100644
--- 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 7acce1968b..00dde1a6c3 100644
--- 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 d2602a2db7..3897ab16c5 100755
--- 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 ab0213636c..1395631c15 100644
--- 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 428fc30f61..66df9e1d42 100644
--- 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 1df3af77c1..e5c87bdd5b 100644
--- 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 0fc070e9c5..85aa8841a3 100644
--- 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 394acdb7a6..0d6598f711 100644
--- 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');