On 28 Mar 2005 14:46:54 -0000, via RT Zsban Ambrus <[EMAIL PROTECTED]> wrote: > # New Ticket Created by "Zsban Ambrus" > # Please include the string: [perl #34595] > # in the subject line of all future correspondence about this issue. > # <URL: https://rt.perl.org/rt3/Ticket/Display.html?id=34595 > > > This is a bug report for perl from [EMAIL PROTECTED], > generated with the help of perlbug 1.35 running under perl v5.8.5. > > ----------------------------------------------------------------- > [Please enter your report here] > > In some cases, the 3 argument open statement of perl ignores perlio > layers, when I use it to duplicate file handles. > > For example, this command: > > 'open $dup, "<&=:encoding(iso-8859-2)", *STDIN or die $!; > > opens a duplicate filehandle for STDIN successfully, but does not apply the > encoding layer to it. In contrast, these commands > > open $dup, "<&=", *STDIN or die $!; > binmode $dup, ":encoding(iso-8859-2)" or die $!; > > successfully apply the encoding layer to the dupe handle, while the original > filehandle STDIN is unaffected: it still reads bytes by default. > > The io layer part of the string is sometimes ignored, sometimes it is > scanned for io layers, but are not applied. For example, both of these > > open $dup, ">&=encoding(iso-8859-2)", *STDOUT or die $!; > open $dup2, "<&=encoding(iso-8859-2)", *STDIN or die $!; > > open a dupe filehandle but not apply the layer. If you mis-spell the > encoding like this: > > open $dup2, ">&=encoding(iso-8895-2)", *STDOUT or die $!; > > fails with EINVAL and warns 'Cannot find encoding "iso-8895-2"' (which is, > btw, a warning not documented in perldiag), while this: > > open $dup2, "<&=encoding(iso-8895-2)", *STDIN or die "$!"; > > opens the dupe ignoring the layer part completely. > > I've written a test script to test some of these bugs. This one does not > check whether open fails if given an incorrect layer, it only checks what I > think should be valid. I include the test script below. When I run it, the > following tests fail: > > 28-30, 33-35, 38-40, 43-45, 48-50, 88-90, 93-95, 98-100, 103-105, 108-110 > > I also get a few wide character warnings from the test, which are also > caused by the missing layers. > > Even though this perlbug is that of perl 5.8.5, I've also got the same > results from perl v5.8.6 on the same machine. These are both vanilla perls > built from source, not the ones installed by Gentoo system. > > I tried to trace the error to its origins. I belive the error is in the > Perl_do_openn function (doio.c), but that function was too complicated for > me (600+ lines and I'm no perl wizard), so I'm afraid I won't be able to > write a patch. > > ambrus > > ----------------------------------------------------------------- > #!perl -w > > use warnings; > use strict; > > use Test::More tests => 120; > > use IO::Handle; > use PerlIO; > use File::Temp; > > sub any { > my $f = $_[0]; > my $r; > for (@_[1 .. @_ - 1]) { > $r = &$f($_); > $r and return $r; > }; > $r; > } > > for my $dup_descriptor (0, 1) { > for my $open_argc (3, 2) { > for my $layer_in_open (0, ($open_argc == 3 ? 1 : ())) { > for my $copy_what ($open_argc == 3 ? ("ioref", "glob", "globref") : (), > "fileno", "symref") { > my $iter_summary = ", " . $open_argc . "-arg open, " . $copy_what . > ", dup " . ($dup_descriptor ? "descriptor" : "handle") . > ", " . ($layer_in_open ? "perlio layer in open" : "separate > binmode"); > #warn "+$iter_summary\n"; > my($file, $name) = File::Temp::tempfile(undef, "REMOVE", 1); > defined(fileno($file)) or > die "error: no fileno found on tempfile"; > my $copy_arg = $copy_what eq "ioref" ? *$file{IO} : > $copy_what eq "glob" ? *$file : > $copy_what eq "globref" ? $file : > $copy_what eq "fileno" ? fileno($file) : > $copy_what eq "symref" ? do { *FILE = *$file; "FILE" } : (); > defined($copy_arg) or die "error: copy argument is wrong"; > my @open_arg3 = $open_argc == 3 ? $copy_arg : (); > my $open_arg2 = $open_argc == 2 ? $copy_arg : ""; > my $equals_sign = $dup_descriptor ? "" : "="; > my $layer = ":encoding(iso-8859-2)"; > my $open_layer = $layer_in_open ? $layer : ""; > open my $copy, "+<&" . $equals_sign . $open_layer . $open_arg2, > @open_arg3 or > die "error copy: $!"; > defined(fileno($file)) or > die "error: no fileno found on copy"; > is((fileno($copy) != fileno($file)), !!$dup_descriptor, "fileno > equalty" . $iter_summary); > !$layer_in_open and do { > binmode $copy, $layer or > die "error binmode: $!"; > }; > my @file_layers = PerlIO::get_layers($file); > ok (!any (sub { /^encoding/ }, @file_layers), "orig has no encoding > layer" . $iter_summary); > my @copy_layers = PerlIO::get_layers($copy); > ok (any (sub { /^encoding/ }, @copy_layers), "copy has encoding layer" > . $iter_summary); > print $copy chr(0x151) or > die "error write: $!"; > flush $copy or > die "error flush: $!"; > seek $file, 0, 0 or die "error seek: $!"; > my $s = <$file>; > defined($s) or > die($! ? "eof reading file" : "error reading file: $!"); > is(ord($s), 0xf5, "encoding test" . $iter_summary); > seek $copy, 0, 0 or die "error seek: $!"; > print $file chr(0xf5) or die "error write: $!"; > flush $file; > seek $copy, 0, 0 or die "error seek: $!"; > $s = <$copy>; > defined($s) or > die($! ? "eof reading file" : "error reading file: $!"); > is(ord($s), 0x151, "decoding test" . $iter_summary); > close $file or > die "error close: $!"; > close $copy or > die "error close copy: $!"; > } } } } > > __END__ > > ----------------------------------------------------------------- > > [Please do not change anything below this line] > ----------------------------------------------------------------- > --- > Flags: > category=core > severity=low > --- > Site configuration information for perl v5.8.5: > > Configured by ambrus at Thu Sep 2 22:17:37 CEST 2004. > > Summary of my perl5 (revision 5 version 8 subversion 5) configuration: > Platform: > osname=linux, osvers=2.4.25-gentoo-r2, archname=i686-linux > uname='linux king 2.4.25-gentoo-r2 #4 fri jun 11 18:55:54 cest 2004 i686 > pentium ii (deschutes) genuineintel gnulinux ' > config_args='' > hint=recommended, useposix=true, d_sigaction=define > usethreads=undef use5005threads=undef useithreads=undef > usemultiplicity=undef > useperlio=define d_sfio=undef uselargefiles=define usesocks=undef > use64bitint=undef use64bitall=undef uselongdouble=undef > usemymalloc=n, bincompat5005=undef > Compiler: > cc='cc', ccflags ='-fno-strict-aliasing -pipe -D_LARGEFILE_SOURCE > -D_FILE_OFFSET_BITS=64', > optimize='-O2', > cppflags='-fno-strict-aliasing -pipe' > ccversion='', gccversion='3.3.2 20031218 (Gentoo Linux 3.3.2-r5, > propolice-3.3-7)', gccosandvers='' > intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234 > d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 > ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', > lseeksize=8 > alignbytes=4, prototype=define > Linker and Libraries: > ld='cc', ldflags =' -L/usr/local/lib' > libpth=/usr/local/lib /lib /usr/lib > libs=-lnsl -lndbm -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc > perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc > libc=/lib/libc-2.3.2.so, so=so, useshrplib=false, libperl=libperl.a > gnulibc_version='2.3.2' > Dynamic Linking: > dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E' > cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib' > > Locally applied patches: > > --- > @INC for perl v5.8.5: > /usr/local/lib/perl5/5.8.5/i686-linux > /usr/local/lib/perl5/5.8.5 > /usr/local/lib/perl5/site_perl/5.8.5/i686-linux > /usr/local/lib/perl5/site_perl/5.8.5 > /usr/local/lib/perl5/site_perl > . > > --- > Environment for perl v5.8.5: > HOME=/home/ambrus > LANG (unset) > LANGUAGE (unset) > LC_CTYPE=hu_HU > LD_LIBRARY_PATH (unset) > LOGDIR (unset) > > PATH=/home/ambrus/local/bin:/usr/local/bin:/bin:/usr/bin:/usr/games/bin:/usr/X11R6/bin:/usr/qt/3/bin:/usr/kde/3.2/bin:/opt/Acrobat5 > PERL_BADLANG (unset) > SHELL=/bin/bash
FWIW: I checked this on blead and i got the same results as Ambrus. cheers, yves -- perl -Mre=debug -e "/just|another|perl|hacker/"
