Front page | perl.perl5.porters |
Postings from June 2011
[perl #93652] PerlIO::via does not create a new dynamic scope for $1
From:
perlbug @ spamwagon . com
Date:
June 29, 2011 00:49
Subject:
[perl #93652] PerlIO::via does not create a new dynamic scope for $1
Message ID:
rt-3.6.HEAD-16080-1309216402-1976.93652-75-0@perl.org
# New Ticket Created by perlbug@spamwagon.com
# Please include the string: [perl #93652]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=93652 >
This is a bug report for perl from perlbug@spamwagon.com,
generated with the help of perlbug 1.39 running under perl 5.12.3.
-----------------------------------------------------------------
When PerlIO::via runs the WRITE stack (or possibly any stack),
it does not appear to create a new dynamic scope for each layer
method called. Modifying the global regular expression match
variables like $1 in a lower IO layer can cause $1 to have an
unexpected value in the IO layer above.
Consider the following example. Both PerlIO::via::RegexBug and
PerlIO::via::RegexBugWorkaround perform the same function. They
iterate through the supplied $buffer character by character and
print a space before each one. PerlIO::via::RegexBugWorkaround
preserved the value of $1 in a lexical variable while calling into
the lower layer to print the space, while PerlIO::via::RegexBug
relies on $1's value to remain the same over the call to
print $fh ' ';
PerlIO::via::RegexBugWorkaround can be layered as expected, and
produces output prepended with one or two spaces, depending on
how many times it's been pushed onto the stack.
PerlIO::via::RegexBug works fine when pushed once. When pushed
twice, the value of $1 changes over the "print $fh ' ';" call,
as the lower instance of PerlIO::via::RegexBug matched a space
against the ' ' string.
package PerlIO::via::RegexBug;
use strict;
sub PUSHED {
my ($class, $mode, $fh) = @_;
return bless {}, $class;
}
sub WRITE {
my ($this, $buffer, $fh) = @_;
my $len = length $buffer;
while ($buffer =~ m/\G(.)/gs) {
my $c = $1;
print $fh ' ';
if ($c ne $1) {
die "Invalid output char expected:'$c' got:'$1'\n";
}
print $fh $1;
}
$len;
}
1;
package PerlIO::via::RegexBugWorkaround;
use strict;
sub PUSHED {
my ($class, $mode, $fh) = @_;
return bless {}, $class;
}
sub WRITE {
my ($this, $buffer, $fh) = @_;
my $len = length $buffer;
while ($buffer =~ m/\G(.)/gs) {
my $c = $1;
print $fh ' ';
print $fh $c;
}
$len;
}
1;
package main;
my @lines = <DATA>;
my $out = \*STDOUT;
Header('NORMAL');
TestOutput($out);
Header('WITH 1xRegexBugWorkaround');
binmode $out, ":via(RegexBugWorkaround)";
TestOutput($out);
Header('WITH 2xRegexBugWorkaround');
binmode $out, ":via(RegexBugWorkaround)";
TestOutput($out);
binmode $out, ":pop";
binmode $out, ":pop";
Header('NORMAL');
TestOutput($out);
Header('WITH 1xRegexBug');
binmode $out, ":via(RegexBug)";
TestOutput($out);
Header('WITH 2xRegexBug');
binmode $out, ":via(RegexBug)";
TestOutput($out);
sub Header {
print STDERR "="x40,"\n";
print STDERR "="x4," ",@_,"\n";
print STDERR "="x40,"\n";
}
sub TestOutput {
my $out = shift;
foreach (@lines) {
print $out $_;
}
}
__DATA__
This is some text
which may match
isnt that fun
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=core
severity=low
---
Site configuration information for perl 5.12.3:
Configured by 1 at Sun May 15 16:53:01 2011.
Summary of my perl5 (revision 5 version 12 subversion 3) configuration:
Platform:
osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
uname='Win32 strawberryperl 5.12.3.0 #1 Sun May 15 09:44:53 2011 i386'
config_args='undef'
hint=recommended, useposix=true, d_sigaction=undef
useithreads=define, usemultiplicity=define
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=undef, use64bitall=undef, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='gcc', ccflags =' -s -O2 -DWIN32 -DHAVE_DES_FCRYPT
-DUSE_SITECUSTOMIZE -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS
-fno-strict-aliasing -mms-bitfields -DPERL_MSVCRT_READFIX',
optimize='-s -O2',
cppflags='-DWIN32'
ccversion='', gccversion='4.4.3', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='long
long', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='g++', ldflags ='-s -L"C:\strawberry\perl\lib\CORE"
-L"C:\strawberry\c\lib"'
libpth=C:\strawberry\c\lib C:\strawberry\c\i686-w64-mingw32\lib
libs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32
-ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr
-lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
perllibs=-lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool
-lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid
-lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
libc=, so=dll, useshrplib=true, libperl=libperl512.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags='-mdll -s -L"C:\strawberry\perl\lib\CORE"
-L"C:\strawberry\c\lib"'
Locally applied patches:
---
@INC for perl 5.12.3:
C:/strawberry/perl/site/lib
C:/strawberry/perl/vendor/lib
C:/strawberry/perl/lib
.
---
Environment for perl 5.12.3:
HOME=C:\users\Jerbraun
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=C:\strawberry\perl\bin
PERLDOC=-n "groff.exe -E -mtty-char -Tascii -P-c"
PERL_BADLANG (unset)
PERL_JSON_BACKEND=JSON::XS
PERL_YAML_BACKEND=YAML
SHELL (unset)
-
[perl #93652] PerlIO::via does not create a new dynamic scope for $1
by perlbug @ spamwagon . com