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,
  <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 '->'

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


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

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)

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

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

From @steve-m-hay

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

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