# 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
