[PATCH] Text-Balanced extract_quotelike fails on certain delims in HERE docs #7051

p5pRT · 2004-01-20T06:36:46Z

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

Searchable as RT25157$

p5pRT · 2004-01-20T06:36:47Z

From davidm.perl@math2.org

Created by davidm.perl@math2.org

The following patch corrects an error in Text::Balanced, in extract_quotelike,
where HERE documents are not recognized if certain characters are present
in the HERE document delimiters. For example,

<<"*";\n\n*\n;

The problem is that $label was not escaped with \Q ... \E in the regexes.

The patch also includes a new test case that fails under the original code.

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

Inline Patch

diff -r -u perl-5.8.3/lib/Text/Balanced/t/extqlk.t perl-5.8.3-patched/lib/Text/Balanced/t/extqlk.t
--- 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 01:26:56.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..91\n"; }
  END {print "not ok 1\n" unless $loaded;}
  use Text::Balanced qw ( extract_quotelike );
  $loaded = 1;
@@ -81,6 +81,7 @@
  <<"   EOHERE"; done() \nline1\nline2\n   EOHERE\nand next
  <<""; done()\nline1\nline2\n\n and next
  <<; done()\nline1\nline2\n\n and next
+<<"*";\n\n*\n;


  "this is a nested $var[$x] {";
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-20 01:28:04.000000000 -0500
@@ -749,7 +749,7 @@
  		my $extrapos = pos($$textref);
  		$$textref =~ m{.*\n}gc;
  		$str1pos = pos($$textref);
-		unless ($$textref =~ m{.*?\n(?=$label\n)}gc) {
+		unless ($$textref =~ m{.*?\n(?=\Q$label\E\n)}gc) {
  			_failmsg qq{Missing here doc terminator ('$label') after "} .
  				     substr($$textref, $startpos, 20) .
  				     q{..."},
@@ -758,7 +758,7 @@
  			return;
  		}
  		$rd1pos = pos($$textref);
-		$$textref =~ m{$label\n}gc;
+		$$textref =~ m{\Q$label\E\n}gc;
  		$ld2pos = pos($$textref);
  		return (
  			$startpos,	$oppos-$startpos,	# PREFIX
======================

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 · 2004-01-21T21:22:14Z

From @iabyn

On Tue, Jan 20, 2004 at 06:36:48AM -0000, David Manura wrote:

The following patch corrects an error in Text::Balanced

Could you supply your 5 separate patches as one integrated patch?
In particular, they can't currently be sequentially applied since they
each make a change to same line in the original b/Text/Balanced/t/extqlk.t
file.

Thanks,

Dave.

--
"Strange women lying in ponds distributing swords is no basis for a system
of government. Supreme executive power derives from a mandate from the
masses, not from some farcical aquatic ceremony."
-- Dennis - Monty Python and the Holy Grail.

p5pRT · 2004-01-21T21:22:16Z

The RT System itself - Status changed from 'new' to 'open'

p5pRT · 2004-01-22T02:01:08Z

From dm.list@math2.org

Dave,

Attached is the combined patch for perl # 25151, 25154, 25156, 25157, and 25158
to apply to Text::Balanced 1.95 (perl 5.8.3). Also included in the patch is
some cleanup of extqlk.t.

-davidm

Dave Mitchell wrote:

On Tue, Jan 20, 2004 at 06:36:48AM -0000, David Manura wrote:

The following patch corrects an error in Text::Balanced

Could you supply your 5 separate patches as one integrated patch?
In particular, they can't currently be sequentially applied since they
each make a change to same line in the original b/Text/Balanced/t/extqlk.t
file.

Thanks,

Dave.

p5pRT · 2004-01-22T02:01:08Z

From dm.list@math2.org

textbalanced.patch

diff -r -u perl-5.8.3/lib/Text/Balanced/t/extmul.t perl-5.8.3-patched/lib/Text/Balanced/t/extmul.t
--- perl-5.8.3/lib/Text/Balanced/t/extmul.t	2001-11-19 22:59:36.000000000 -0500
+++ perl-5.8.3-patched/lib/Text/Balanced/t/extmul.t	2004-01-21 19:23:30.000000000 -0500
@@ -13,7 +13,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..85\n"; }
+BEGIN { $| = 1; print "1..86\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( :ALL );
 $loaded = 1;
@@ -316,3 +316,10 @@
 
 expect [ pos ], [ 0 ];
 expect [ $_ ], [ substr($stdtext3,2) ];
+
+# TEST 86
+
+# Fails in Text-Balanced-1.95 with result ['1 ', '""', '1234']
+$_ = q{ ""1234};
+expect	[ extract_multiple(undef, [\&extract_quotelike]) ],
+	[ ' ', '""', '1234' ];
diff -r -u perl-5.8.3/lib/Text/Balanced/t/extqlk.t perl-5.8.3-patched/lib/Text/Balanced/t/extqlk.t
--- 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-21 20:23:50.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..95\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( extract_quotelike );
 $loaded = 1;
@@ -23,6 +23,7 @@
 use vars qw( $DEBUG );
 # $DEBUG=1;
 sub debug { print "\t>>>",@_ if $DEBUG }
+sub esc   { my $x = shift; $x =~ s/\n/\\n/gs; $x }
 
 ######################### End of black magic.
 
@@ -32,36 +33,52 @@
 while (defined($str = <DATA>))
 {
 	chomp $str;
-	if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
+	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 }
-	debug "\tUsing: $cmd\n";
-	debug "\t   on: [$str]\n";
+	elsif (!$str || $str =~ /\A#/)              { $neg = 0; next }
+	my $setup_cmd = ($str =~ s/\A\{(.*)\}//) ? $1 : '';
+	my $tests = 'sl';
 	$str =~ s/\\n/\n/g;
 	my $orig = $str;
 
-	 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];
-	debug "\t  pos: " . (map { s/\n/\\n/g; "[$_]\n" } my $cpy2 = substr($str,pos($str)))[0] . "...]\n";
-	print "not " if (substr($str,pos($str),1) eq ';')==$neg;
-	print "ok ", $count++;
-	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 =~ /l/) {
+		debug "\tUsing: $cmd\n";
+		debug "\t   on: [" . esc($setup_cmd) . "][" . esc($str) . "]\n";
+		my @res;
+		eval qq{\@res = $cmd; };
+		debug "\t  got:\n" . join "", map { "\t\t\t$_: [" . esc($res[$_]) . "]\n"} (0..$#res);
+		debug "\t left: [" . esc($str) . "]\n";
+		debug "\t  pos: [" . esc(substr($str,pos($str))) . "...]\n";
+		print "not " if (substr($str,pos($str),1) eq ';')==$neg;
+		print "ok ", $count++;
+		print "\n";
+	}
+
+	eval $setup_cmd if $setup_cmd ne '';
+	if($tests =~ /s/) {
+		$str = $orig;
+		debug "\tUsing: scalar $cmd\n";
+		debug "\t   on: [" . esc($str) . "]\n";
+		$var = eval $cmd;
+		print " ($@)" if $@ && $DEBUG;
+		$var = "<undef>" unless defined $var;
+		debug "\t scalar got: [" . esc($var) . "]\n";
+		debug "\t scalar left: [" . esc($str) . "]\n";
+		print "not " if ($str =~ '\A;')==$neg;
+		print "ok ", $count++;
+		print "\n";
+	}
 }
 
+# fails in Text::Balanced 1.95
+$_ = qq(s{}{});
+my @z = extract_quotelike();
+print "not " if $z[0] eq '';
+print "ok ", $count++;
+print "\n";
+
+ 
 __DATA__
 
 # USING: extract_quotelike($str);
@@ -81,7 +98,10 @@
 <<"   EOHERE"; done() \nline1\nline2\n   EOHERE\nand next
 <<""; done()\nline1\nline2\n\n and next
 <<; done()\nline1\nline2\n\n and next
-
+# fails in Text::Balanced 1.95
+<<EOHERE;\nEOHERE\n; 
+# fails in Text::Balanced 1.95
+<<"*";\n\n*\n; 
 
 "this is a nested $var[$x] {";
 /a/gci;
@@ -111,6 +131,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-21 20:24:28.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")} ;
@@ -748,8 +749,8 @@
 		}
 		my $extrapos = pos($$textref);
 		$$textref =~ m{.*\n}gc;
-		$str1pos = pos($$textref);
-		unless ($$textref =~ m{.*?\n(?=$label\n)}gc) {
+		$str1pos = pos($$textref)--;
+		unless ($$textref =~ m{.*?\n(?=\Q$label\E\n)}gc) {
 			_failmsg qq{Missing here doc terminator ('$label') after "} .
 				     substr($$textref, $startpos, 20) .
 				     q{..."},
@@ -758,7 +759,7 @@
 			return;
 		}
 		$rd1pos = pos($$textref);
-		$$textref =~ m{$label\n}gc;
+		$$textref =~ m{\Q$label\E\n}gc;
 		$ld2pos = pos($$textref);
 		return (
 			$startpos,	$oppos-$startpos,	# PREFIX
@@ -791,7 +792,7 @@
 	if ($ldel1 =~ /[[(<{]/)
 	{
 		$rdel1 =~ tr/[({</])}>/;
-		_match_bracketed($textref,"",$ldel1,"","",$rdel1)
+		defined(_match_bracketed($textref,"",$ldel1,"","",$rdel1))
 		|| do { pos $$textref = $startpos; return };
 	}
 	else
@@ -826,7 +827,7 @@
 		if ($ldel2 =~ /[[(<{]/)
 		{
 			pos($$textref)--;	# OVERCOME BROKEN LOOKAHEAD 
-			_match_bracketed($textref,"",$ldel2,"","",$rdel2)
+			defined(_match_bracketed($textref,"",$ldel2,"","",$rdel2))
 			|| do { pos $$textref = $startpos; return };
 		}
 		else
@@ -930,7 +931,7 @@
 				if (defined($field) && length($field))
 				{
 					if (!$igunk) {
-						$unkpos = pos $$textref
+						$unkpos = $lastpos
 							if length($pref) && !defined($unkpos);
 						if (defined $unkpos)
 						{

p5pRT · 2005-07-13T10:15:10Z

From @steve-m-hay

Jumbo patch incorporating all five fixes now committed to bleadperl.

p5pRT · 2005-07-13T10:15:11Z

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

p5pRT closed this as completed Jul 13, 2005

p5pRT added Severity Medium distro-mswin32 type-library labels Oct 18, 2019

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

[PATCH] Text-Balanced extract_quotelike fails on certain delims in HERE docs #7051

[PATCH] Text-Balanced extract_quotelike fails on certain delims in HERE docs #7051

p5pRT commented Jan 20, 2004

p5pRT commented Jan 20, 2004

p5pRT commented Jan 21, 2004

p5pRT commented Jan 21, 2004

p5pRT commented Jan 22, 2004

p5pRT commented Jan 22, 2004

p5pRT commented Jul 13, 2005

p5pRT commented Jul 13, 2005

[PATCH] Text-Balanced extract_quotelike fails on certain delims in HERE docs #7051

[PATCH] Text-Balanced extract_quotelike fails on certain delims in HERE docs #7051

Comments

p5pRT commented Jan 20, 2004

p5pRT commented Jan 20, 2004

From davidm.perl@math2.org

Created by davidm.perl@math2.org

p5pRT commented Jan 21, 2004

From @iabyn

p5pRT commented Jan 21, 2004

p5pRT commented Jan 22, 2004

From dm.list@math2.org

p5pRT commented Jan 22, 2004

From dm.list@math2.org

p5pRT commented Jul 13, 2005

From @steve-m-hay

p5pRT commented Jul 13, 2005