New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
pragma open handles STDERR improperly #11441
Comments
From uhuruh@gmail.comThis is a bug report for perl from Yunfeng Wang <uhuruh@gmail.com>, After the default PerlIO layer for STDIN/STDOUT/STDERR been set with Example code: 1. use open ':encoding(UTF-8)', ':std'; Here is a patch to fix this bug: Inline Patch--- /usr/share/perl/5.12.3/open.pm 2011-05-20 03:02:33.000000000 +0800
+++ open.pm 2011-06-13 19:03:59.000000000 +0800
@@ -100,11 +100,13 @@
}
elsif ($type eq 'OUT') {
_drop_oldenc(*STDOUT, @val);
+ _drop_oldenc(*STDERR, @val);
$out = join(' ', @val);
}
elsif ($type eq 'IO') {
_drop_oldenc(*STDIN, @val);
_drop_oldenc(*STDOUT, @val);
+ _drop_oldenc(*STDERR, @val);
$in = $out = join(' ', @val);
}
else {
-----------------------------------------------------------------
---
Site configuration information for perl 5.12.3: Configured by Debian Project at Thu May 19 18:42:35 UTC 2011. Summary of my perl5 (revision 5 version 12 subversion 3) configuration: Locally applied patches: @INC for perl 5.12.3: Environment for perl 5.12.3: |
From @cpansproutOn Mon Jun 13 05:04:49 2011, uhuruh@gmail.com wrote:
While they should be treated the same way, are you sure it’s STDERR, and Doing anything with STD* handles without :std’s having been specified |
The RT System itself - Status changed from 'new' to 'open' |
From @cpansproutOn Sun Jun 19 12:20:09 2011, sprout wrote:
What do others think about this? |
From [Unknown Contact. See original ticket]On Sun Jun 19 12:20:09 2011, sprout wrote:
What do others think about this? |
From tchrist@perl.com"Father Chrysostomos via RT" <perlbug-comment@perl.org> wrote
Yeah, kinda seems like it. That said, I've been too burned by the fatal combo of use open --tom |
From @cpansproutOn Sun Sep 11 17:13:29 2011, tom christiansen wrote:
(CPAN bug #54777) autodie is completely broken, as it does not propagate pragmata, and If it were re-implemented in XS, it would probably take much much less
|
From [Unknown Contact. See original ticket]On Sun Sep 11 17:13:29 2011, tom christiansen wrote:
(CPAN bug #54777) autodie is completely broken, as it does not propagate pragmata, and If it were re-implemented in XS, it would probably take much much less
|
From @TuxOn Sun, 11 Sep 2011 16:29:19 -0700, "Father Chrysostomos via RT"
I feel the described situation as inconsistent and thus buggy There are way more difficult bugs (open) with open pragma and encoding. Se e.g. https://rt.cpan.org/Ticket/Display.html?id=66474 -- |
From @pjcjOn Sun, Sep 11, 2011 at 06:22:55PM -0700, Father Chrysostomos via RT wrote:
If someone /were/ to undertake such a task, I would *really* like to see (And if it's not quite backwards compatible, we can even give it a decent -- |
From @cpansproutOn Sun Sep 11 23:25:50 2011, hmbrand wrote:
Ouch! I would definitely consider that a bug. But I have *no* idea how |
From [Unknown Contact. See original ticket]On Sun Sep 11 23:25:50 2011, hmbrand wrote:
Ouch! I would definitely consider that a bug. But I have *no* idea how |
From @LeontOn Mon, Sep 12, 2011 at 8:25 AM, H.Merijn Brand <h.m.brand@xs4all.nl> wrote:
Yeah, I've got two bugs against open too (#96008 and #97822). Quite Leon |
From @cpansproutOn Sun Jun 19 12:20:09 2011, sprout wrote:
That’s now fixed with commit 73f1eac. |
From @cpansproutOn Mon Sep 12 02:50:31 2011, paul@pjcj.net wrote:
Like Fatal, perhaps? |
From [Unknown Contact. See original ticket]On Mon Sep 12 02:50:31 2011, paul@pjcj.net wrote:
Like Fatal, perhaps? |
@cpansprout - Status changed from 'open' to 'resolved' |
From @cpansproutOn Mon Sep 12 06:02:42 2011, sprout wrote:
Attached is a page of efficient hacks. I still have to get it working |
From @cpansproutInline Patchdiff --git a/MANIFEST b/MANIFEST
index 1cd70f6..4ed4aa1 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -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 09143f2..e6f5567 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 d696603..ac56453 100644
--- a/dist/IO/IO.xs
+++ b/dist/IO/IO.xs
@@ -142,6 +142,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 +478,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 c15e5a3..68e6d90 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 effd414..382e282 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 0000000..c97c260
--- /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";
+} |
From [Unknown Contact. See original ticket]On Mon Sep 12 06:02:42 2011, sprout wrote:
Attached is a page of efficient hacks. I still have to get it working |
From tchrist@perl.com"Father Chrysostomos via RT" <perlbug-comment@perl.org> wrote
What's the deal with how/whether the open works on magic ARGV? Is the answer version-dependent? --tom |
From @cpansproutOn Sat Sep 17 09:26:32 2011, tom christiansen wrote:
<ARGV> does an implicit open using the lexical hints at the point where That means that ‘use open ...; while(<>)’ will set the layers on ARGV Because IO::Handle::getline is a Perl subroutine, the <ARGV> is called My patch fiddles PL_curcop to make getline’s caller’s hints visible to <>.
No. In fact, with the #ifndef show below, my patch works all the way And that ‘No’ applies, whether you are referring to the IO::Handle bug, #ifndef dVAR |
From [Unknown Contact. See original ticket]On Sat Sep 17 09:26:32 2011, tom christiansen wrote:
<ARGV> does an implicit open using the lexical hints at the point where That means that ‘use open ...; while(<>)’ will set the layers on ARGV Because IO::Handle::getline is a Perl subroutine, the <ARGV> is called My patch fiddles PL_curcop to make getline’s caller’s hints visible to <>.
No. In fact, with the #ifndef show below, my patch works all the way And that ‘No’ applies, whether you are referring to the IO::Handle bug, #ifndef dVAR |
From @cpansproutOn Sat Sep 17 00:10:19 2011, sprout wrote:
Now applied as 986a805. |
From [Unknown Contact. See original ticket]On Sat Sep 17 00:10:19 2011, sprout wrote:
Now applied as 986a805. |
Migrated from rt.perl.org#92728 (status was 'resolved')
Searchable as RT92728$
The text was updated successfully, but these errors were encountered: