[PATCH] Text::Balanced _succeed() fails on fillet

[p5pRT]

Migrated from rt.perl.org#25154 (status was 'resolved')

Searchable as RT25154$

[p5pRT]

From davidm.perl@math2.org

Created by davidm.perl@math2.org

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\,   \ 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).

==================

Inline Patch

```diff --- 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 = "" 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 = "" 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`; - <{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~

Inline Patch

```diff 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")} ; ================== ```

Perl Info

``` 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) ```

[p5pRT]

From davidm.perl@math2.org

Just to cross-reference\, this bug was also reported on CPAN by another person (https://rt.cpan.org/NoAuth/Bug.html?id=752).&nbsp; The above patch and the cpan bug report are superceeded by the patch given in perlbug 25157.

-davidm

[davidmanura - Mon Jan 19 22​:09​:11 2004]​:

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\, \ 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 = "\" 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 = "\" 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)

[p5pRT]

davidm.perl@math2.org - Status changed from 'new' to 'open'

[p5pRT]

From @steve-m-hay

Now fixed in bleadperl by the jumbo patch in ticket #25157.

[p5pRT]

@steve-m-hay - Status changed from 'open' to 'resolved'