diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | dist/IO/IO.pm | 2 | ||||
| -rw-r--r-- | dist/IO/IO.xs | 37 | ||||
| -rw-r--r-- | dist/IO/lib/IO/Handle.pm | 10 | ||||
| -rw-r--r-- | dist/IO/t/IO.t | 2 | ||||
| -rw-r--r-- | dist/IO/t/io_utf8argv.t | 38 | ||||
| -rw-r--r-- | pod/perldelta.pod | 13 |
7 files changed, 99 insertions, 4 deletions
@@ -3172,6 +3172,7 @@ dist/IO/t/io_taint.t See if the untaint method from IO works dist/IO/t/io_tell.t See if seek()/tell()-related methods from IO work dist/IO/t/io_udp.t See if UDP socket-related methods from IO work dist/IO/t/io_unix.t See if UNIX socket-related methods from IO work +dist/IO/t/io_utf8argv.t See if <> respects open pragma dist/IO/t/io_utf8.t See if perlio opens work dist/IO/t/io_xs.t See if XSUB methods from IO work dist/lib/lib_pm.PL For "use lib", produces lib/lib.pm diff --git a/dist/IO/IO.pm b/dist/IO/IO.pm index 09143f2e39..e6f5567b9f 100644 --- a/dist/IO/IO.pm +++ b/dist/IO/IO.pm @@ -7,7 +7,7 @@ use Carp; use strict; use warnings; -our $VERSION = "1.25_05"; +our $VERSION = "1.25_06"; XSLoader::load 'IO', $VERSION; sub import { diff --git a/dist/IO/IO.xs b/dist/IO/IO.xs index d696603eac..0501567157 100644 --- a/dist/IO/IO.xs +++ b/dist/IO/IO.xs @@ -57,6 +57,10 @@ typedef FILE * OutputStream; # define NORETURN_FUNCTION_END /* NOT REACHED */ return 0 #endif +#ifndef dVAR +# define dVAR dNOOP +#endif + static int not_here(const char *s) __attribute__noreturn__; static int not_here(const char *s) @@ -142,6 +146,27 @@ io_blocking(pTHX_ InputStream f, int block) #endif } +static OP * +io_pp_nextstate(pTHX) +{ + dVAR; + COP *old_curcop = PL_curcop; + OP *next = PL_ppaddr[PL_op->op_type](aTHX); + PL_curcop = old_curcop; + return next; +} + +static OP * +io_ck_lineseq(pTHX_ OP *o) +{ + OP *kid = cBINOPo->op_first; + for (; kid; kid = kid->op_sibling) + if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) + kid->op_ppaddr = io_pp_nextstate; + return o; +} + + MODULE = IO PACKAGE = IO::Seekable PREFIX = f void @@ -457,6 +482,18 @@ fsync(handle) OUTPUT: RETVAL +SV * +_create_getline_subs(const char *code) + PREINIT: + SV *ret; + CODE: + OP *(*io_old_ck_lineseq)(pTHX_ OP *) = PL_check[OP_LINESEQ]; + PL_check[OP_LINESEQ] = io_ck_lineseq; + RETVAL = SvREFCNT_inc(eval_pv(code,FALSE)); + PL_check[OP_LINESEQ] = io_old_ck_lineseq; + OUTPUT: + RETVAL + MODULE = IO PACKAGE = IO::Socket diff --git a/dist/IO/lib/IO/Handle.pm b/dist/IO/lib/IO/Handle.pm index c15e5a36f0..68e6d902e4 100644 --- a/dist/IO/lib/IO/Handle.pm +++ b/dist/IO/lib/IO/Handle.pm @@ -268,7 +268,7 @@ use IO (); # Load the XS module require Exporter; @ISA = qw(Exporter); -$VERSION = "1.32"; +$VERSION = "1.33"; $VERSION = eval $VERSION; @EXPORT_OK = qw( @@ -430,14 +430,14 @@ sub say { print $this @_; } +# Special XS wrapper to make them inherit lexical hints from the caller. +_create_getline_subs( <<'END' ) or die $@; sub getline { @_ == 1 or croak 'usage: $io->getline()'; my $this = shift; return scalar <$this>; } -*gets = \&getline; # deprecated - sub getlines { @_ == 1 or croak 'usage: $io->getlines()'; wantarray or @@ -445,6 +445,10 @@ sub getlines { my $this = shift; return <$this>; } +1; # return true for error checking +END + +*gets = \&getline; # deprecated sub truncate { @_ == 2 or croak 'usage: $io->truncate(LEN)'; diff --git a/dist/IO/t/IO.t b/dist/IO/t/IO.t index effd414a4c..382e282a07 100644 --- a/dist/IO/t/IO.t +++ b/dist/IO/t/IO.t @@ -21,8 +21,10 @@ plan(tests => 18); my @load; local $^W; + my $xsl = \&XSLoader::load; local *XSLoader::load = sub { push @load, \@_; + &$xsl(@_); }; # use_ok() calls import, which we do not want to do diff --git a/dist/IO/t/io_utf8argv.t b/dist/IO/t/io_utf8argv.t new file mode 100644 index 0000000000..c97c260181 --- /dev/null +++ b/dist/IO/t/io_utf8argv.t @@ -0,0 +1,38 @@ +#!./perl + +BEGIN { + unless ($] >= 5.008 and find PerlIO::Layer 'perlio') { + print "1..0 # Skip: not perlio\n"; + exit 0; + } + require($ENV{PERL_CORE} ? "../../t/test.pl" : "./t/test.pl"); +} + +use utf8; + + +plan(tests => 2); + +open my $fh, ">", 'io_utf8argv'; +print $fh + "\xce\x9c\xe1\xbd\xb7\xce\xb1\x20\xcf\x80\xe1\xbd\xb1\xcf\x80\xce". + "\xb9\xce\xb1\x2c\x20\xce\xbc\xe1\xbd\xb0\x20\xcf\x80\xce\xbf\xce". + "\xb9\xe1\xbd\xb0\x20\xcf\x80\xe1\xbd\xb1\xcf\x80\xce\xb9\xce\xb1". + "\xcd\xbe\x0a"; +close $fh or die "close: $!"; + + +use open ":std", ":utf8"; + +use IO::Handle; + +@ARGV = ('io_utf8argv') x 2; +is *ARGV->getline, "Μία πάπια, μὰ ποιὰ πάπια;\n", + 'getline respects open pragma when magically opening ARGV'; + +is join('',*ARGV->getlines), "Μία πάπια, μὰ ποιὰ πάπια;\n", + 'getlines respects open pragma when magically opening ARGV'; + +END { + 1 while unlink "io_utf8argv"; +} diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 57c8f86931..9304c49740 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -275,6 +275,19 @@ method are now hidden from filters that do not want to deal with strings =item * +L<IO> has been upgraded from version 1.25_05 to 1.25_06, and L<IO::Handle> +from version 1.32 to 1.33. + +Together, these upgrades fix a problem with IO::Handle's C<getline> and +C<getlines> methods. When these methods are called on the special ARGV +handle, the next file is automatically opened, as happens with the built-in +C<< <> >> and C<readline> functions. But, unlike the built-ins, these +methods were not respecting the caller's use of the L<open> pragma and +applying the approprate I/O layers to the newly-opened file +[rt.cpan.org #66474]. + +=item * + L<Math::BigRat> has been upgraded from version 0.2602 to version 0.2603. C<int()> on a Math::BigRat object containing -1/2 now creates a |