From: Rafael Garcia-Suarez Date: Sat, 24 Mar 2007 21:14:22 +0000 (+0000) Subject: Make readline() default to *ARGV. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e4b7ebf3387ae98739a0f53e0f27fa7a6228338f;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 ck_null t% F? +readline 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 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4259,14 +4259,17 @@ C there, it would have been testing the wrong file. closedir DIR; =item readline EXPR + +=item readline X X X -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. +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. When C<$/> is set to C, 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 --- 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 --- 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 --- 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 --- 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) { $_ = } }; 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 .= ; like($obj, qr/main=ARRAY.*world/, 'rcatline and refs');