diff options
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 4 | ||||
| -rw-r--r-- | op.c | 23 | ||||
| -rw-r--r-- | opcode.h | 2 | ||||
| -rwxr-xr-x | opcode.pl | 2 | ||||
| -rw-r--r-- | pod/perlfunc.pod | 15 | ||||
| -rw-r--r-- | pp.sym | 1 | ||||
| -rw-r--r-- | pp_proto.h | 1 | ||||
| -rw-r--r-- | proto.h | 4 | ||||
| -rw-r--r-- | t/op/readline.t | 6 |
10 files changed, 49 insertions, 10 deletions
@@ -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 @@ -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) @@ -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; } @@ -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 */ @@ -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 @@ -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) @@ -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'); |