Front page | perl.perl5.porters |
Postings from January 2004
[perl #25154] [PATCH] Text::Balanced _succeed() fails on fillet
From:
David Manura
Date:
January 19, 2004 22:23
Subject:
[perl #25154] [PATCH] Text::Balanced _succeed() fails on fillet
Message ID:
rt-3.0.8-25154-71450.18.1435658733459@perl.org
# New Ticket Created by David Manura
# Please include the string: [perl #25154]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=25154 >
This is a bug report for perl from davidm.perl@math2.org,
generated with the help of perlbug 1.34 running under perl v5.8.3.
-----------------------------------------------------------------
[Please enter your report here]
The following patch corrects an error in Text::Balanced, in the _succeed() function,
in the code to correct the HERE doc fillet. The following error is seen:
failed: substr outside of string at ../Text-Balanced-1.95/lib/Text/Balanced.pm line 70,
<DATA> line 54.
The error was only noticed when performing an extract_quotelike in list context with
pos() non-zero. Specifically, the calculated start index of the fillet did not take
into account the possibility that pos() could be non-zero before the start of the call.
Therefore, the code attempted to invoke substr using and out-of-bounds start index.
Included also in this patch is a test case that fails with the original code. The
testing code had to be extended to selectively permit pos($str) to be set on a given
test and to run a given test only under list context (rather than the pair of scalar
and list context tests).
==================
--- perl-5.8.3/lib/Text/Balanced/t/extqlk.t 2001-11-19 22:59:36.000000000 -0500
+++ perl-5.8.3-patched/lib/Text/Balanced/t/extqlk.t 2004-01-20 00:38:24.000000000 -0500
@@ -14,7 +14,7 @@
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
-BEGIN { $| = 1; print "1..89\n"; }
+BEGIN { $| = 1; print "1..90\n"; }
END {print "not ok 1\n" unless $loaded;}
use Text::Balanced qw ( extract_quotelike );
$loaded = 1;
@@ -35,12 +35,15 @@
if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+ my $setup_cmd = ($str =~ s/\A\{(.*)\}//) ? $1 : '';
+ my $tests = 'sl';
debug "\tUsing: $cmd\n";
debug "\t on: [$str]\n";
$str =~ s/\\n/\n/g;
my $orig = $str;
- my @res;
+ eval $setup_cmd if $setup_cmd ne '';
+ my @res;
eval qq{\@res = $cmd; };
debug "\t got:\n" . join "", map { $res[$_]=~s/\n/\\n/g; "\t\t\t$_: [$res[$_]]\n"} (0..$#res);
debug "\t left: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy1 = $str)[0];
@@ -50,16 +53,19 @@
print "\n";
$str = $orig;
- debug "\tUsing: scalar $cmd\n";
- debug "\t on: [$str]\n";
- $var = eval $cmd;
- print " ($@)" if $@ && $DEBUG;
- $var = "<undef>" unless defined $var;
- debug "\t scalar got: " . (map { s/\n/\\n/g; "[$_]\n" } $var)[0];
- debug "\t scalar left: " . (map { s/\n/\\n/g; "[$_]\n" } $str)[0];
- print "not " if ($str =~ '\A;')==$neg;
- print "ok ", $count++;
- print "\n";
+ eval $setup_cmd if $setup_cmd ne '';
+ if($tests =~ /s/) {
+ debug "\tUsing: scalar $cmd\n";
+ debug "\t on: [$str]\n";
+ $var = eval $cmd;
+ print " ($@)" if $@ && $DEBUG;
+ $var = "<undef>" unless defined $var;
+ debug "\t scalar got: " . (map { s/\n/\\n/g; "[$_]\n" } $var)[0];
+ debug "\t scalar left: " . (map { s/\n/\\n/g; "[$_]\n" } $str)[0];
+ print "not " if ($str =~ '\A;')==$neg;
+ print "ok ", $count++;
+ print "\n";
+ }
}
__DATA__
@@ -71,7 +77,6 @@
'b';
`cc`;
-
<<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
<<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
<<"EOHERE"; done()\nline1\nline2\nEOHERE\n and next
@@ -111,6 +116,9 @@
tr/x/y/;
y/x/y/;
+# fails on Text-Balanced-1.95
+{ $tests = 'l'; pos($str)=6 }012345<<E;\n\nE\n
+
# THESE SHOULD FAIL
s<$self->{pat}>{$self->{sub}}; # CAN'T HANDLE '>' in '->'
s-$self->{pap}-$self->{sub}-; # CAN'T HANDLE '-' in '->'
Only in perl-5.8.3-patched/lib/Text/Balanced/t: extqlk.t~
diff -r -u perl-5.8.3/lib/Text/Balanced.pm perl-5.8.3-patched/lib/Text/Balanced.pm
--- perl-5.8.3/lib/Text/Balanced.pm 2003-07-04 10:33:00.000000000 -0400
+++ perl-5.8.3-patched/lib/Text/Balanced.pm 2004-01-19 23:50:58.000000000 -0500
@@ -58,6 +58,7 @@
my ($wantarray,$textref) = splice @_, 0, 2;
my ($extrapos, $extralen) = @_>18 ? splice(@_, -2, 2) : (0,0);
my ($startlen) = $_[5];
+ my $oppos = $_[6];
my $remainderpos = $_[2];
if ($wantarray)
{
@@ -67,7 +68,7 @@
push @res, substr($$textref,$from,$len);
}
if ($extralen) { # CORRECT FILLET
- my $extra = substr($res[0], $extrapos-$startlen, $extralen, "\n");
+ my $extra = substr($res[0], $extrapos-$oppos, $extralen, "\n");
$res[1] = "$extra$res[1]";
eval { substr($$textref,$remainderpos,0) = $extra;
substr($$textref,$extrapos,$extralen,"\n")} ;
==================
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=library
severity=medium
---
Site configuration information for perl v5.8.3:
Configured by dmanura at Mon Jan 19 21:39:59 2004.
Summary of my perl5 (revision 5 version 8 subversion 3) configuration:
Platform:
osname=MSWin32, osvers=4.0, archname=MSWin32-x86-multi-thread
uname=''
config_args='undef'
hint=recommended, useposix=true, d_sigaction=undef
usethreads=undef use5005threads=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='cl', ccflags ='-nologo -Gf -W3 -MD -DNDEBUG -O1 -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE_DES_FCRYPT -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READFIX',
optimize='-MD -DNDEBUG -O1',
cppflags='-DWIN32'
ccversion='', gccversion='', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='link', ldflags ='-nologo -nodefaultlib -release -libpath:"c:\perl\lib\CORE" -machine:x86'
libpth=D:\lib\mvs-6.0\VC98\lib
libs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.lib
perllibs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.lib
libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl58.lib
gnulibc_version='undef'
Dynamic Linking:
dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -release -libpath:"c:\perl\lib\CORE" -machine:x86'
Locally applied patches:
---
@INC for perl v5.8.3:
d:/testing/perl-5.8.3/lib
.
---
Environment for perl v5.8.3:
HOME=
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=
PERLDB_OPTS=RemotePort=127.0.0.1:2000
PERL_BADLANG (unset)
SHELL (unset)
-
[perl #25154] [PATCH] Text::Balanced _succeed() fails on fillet
by David Manura