Upgrade to Text-Balanced-1.98

p4raw-id: //depot/perl@28105

11 files changed, 85 insertions, 80 deletions

diff --git a/lib/Text/Balanced.pm b/lib/Text/Balanced.pm
index 297e8df55e..2c84a5a3ac 100644
--- a/lib/Text/Balanced.pm
+++ b/lib/Text/Balanced.pm
@@ -9,7 +9,7 @@ package Text::Balanced;
 use Exporter;
 use vars qw { $VERSION @ISA %EXPORT_TAGS };
 
-$VERSION = '1.95_01';
+$VERSION = '1.97';
 @ISA		= qw ( Exporter );
 		     
 %EXPORT_TAGS	= ( ALL => [ qw(
@@ -55,7 +55,7 @@ sub _fail
 {
 	my ($wantarray, $textref, $message, $pos) = @_;
 	_failmsg $message, $pos if $message;
-	return ("",$$textref,"") if $wantarray;
+	return (undef,$$textref,undef) if $wantarray;
 	return undef;
 }
 
@@ -64,8 +64,7 @@ sub _succeed
 	$@ = undef;
 	my ($wantarray,$textref) = splice @_, 0, 2;
 	my ($extrapos, $extralen) = @_>18 ? splice(@_, -2, 2) : (0,0);
-	my ($startlen) = $_[5];
-	my $oppos = $_[6];
+	my ($startlen, $oppos) = $_[5,6];
 	my $remainderpos = $_[2];
 	if ($wantarray)
 	{
@@ -274,7 +273,7 @@ sub _match_bracketed($$$$$$)	# $textref, $pre, $ldel, $qdel, $quotelike, $rdel
 	       );
 }
 
-sub revbracket($)
+sub _revbracket($)
 {
 	my $brack = reverse $_[0];
 	$brack =~ tr/[({</])}>/;
@@ -337,7 +336,7 @@ sub _match_tagged	# ($$$$$$$)
 	if (!defined $rdel)
 	{
 		$rdelspec = $&;
-		unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". revbracket($1) /oes)
+		unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". _revbracket($1) /oes)
 		{
 			_failmsg "Unable to construct closing tag to match: $rdel",
 				 pos $$textref;
@@ -729,7 +728,8 @@ sub _match_quotelike($$$$)	# ($textref, $prepat, $allow_raw_match)
 		       );
 	}
 
-	unless ($$textref =~ m{\G(\b(?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<)}gc)
+	unless ($$textref =~
+    m{\G(\b(?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<(?=\s*["'A-Za-z_]))}gc)
 	{
 		_failmsg q{No quotelike operator found after prefix at "} .
 			     substr($$textref, pos($$textref), 20) .
@@ -928,9 +928,7 @@ sub extract_multiple (;$$$$)	# ($text, $functions_ref, $max_fields, $ignoreunkno
 				$class = $class[$i];
 				$lastpos = pos $$textref;
 				if (ref($func) eq 'CODE')
-					{ ($field,$rem,$pref) = @bits = $func->($$textref);
-					# print "[$field|$rem]" if $field;
-					}
+					{ ($field,$rem,$pref) = @bits = $func->($$textref) }
 				elsif (ref($func) eq 'Text::Balanced::Extractor')
 					{ @bits = $field = $func->extract($$textref) }
 				elsif( $$textref =~ m/\G$func/gc )
@@ -1153,7 +1151,7 @@ elements of which are always:
 =item [0]
 
 The extracted string, including the specified delimiters.
-If the extraction fails an empty string is returned.
+If the extraction fails C<undef> is returned.
 
 =item [1]
 
@@ -1163,7 +1161,7 @@ extracted string). On failure, the entire string is returned.
 =item [2]
 
 The skipped prefix (i.e. the characters before the extracted string).
-On failure, the empty string is returned.
+On failure, C<undef> is returned.
 
 =back 
 
@@ -2149,9 +2147,10 @@ If more delimiters than escape chars are specified, the last escape char
 is used for the remaining delimiters.
 If no escape char is specified for a given specified delimiter, '\' is used.
 
-Note that 
-C<gen_delimited_pat> was previously called
-C<delimited_pat>. That name may still be used, but is now deprecated.
+=head2 C<delimited_pat>
+
+Note that C<gen_delimited_pat> was previously called C<delimited_pat>.
+That name may still be used, but is now deprecated.
         
 
 =head1 DIAGNOSTICS
diff --git a/lib/Text/Balanced/Changes b/lib/Text/Balanced/Changes
index c8c79fb487..dfdae9abc9 100644
--- a/lib/Text/Balanced/Changes
+++ b/lib/Text/Balanced/Changes
@@ -299,3 +299,23 @@ Revision history for Perl extension Text::Balanced.
 	- Constrainted _match_quote to only match at word boundaries
 	  (so "exemplum(hic)" doesn't match "m(hic)")
 	  (thanks Craig)
+
+
+
+1.96.0  Mon May  1 21:52:37 2006
+
+	- Fixed major bug in extract_multiple handling of unknowns
+
+	- Fixed return value on failure (thanks Eric)
+
+    - Fixed bug differentiating heredocs and left-shift operators
+      (thanks Anthony)
+
+1.97   Mon May  1 21:58:04 2006
+
+    - Removed three-part version number and dependency on version.pm
+
+
+1.98  Fri May  5 14:58:49 2006
+
+    - Reinstated full test suite (thanks Steve!)
diff --git a/lib/Text/Balanced/t/00.load.t b/lib/Text/Balanced/t/00.load.t
new file mode 100755
index 0000000000..79bc6f06a6
--- /dev/null
+++ b/lib/Text/Balanced/t/00.load.t
@@ -0,0 +1,7 @@
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'Text::Balanced' );
+}
+
+diag( "Testing Text::Balanced $Text::Balanced::VERSION" );
diff --git a/lib/Text/Balanced/t/extcbk.t b/lib/Text/Balanced/t/extcbk.t
index 80553ab1a2..30b7e502cb 100644
--- a/lib/Text/Balanced/t/extcbk.t
+++ b/lib/Text/Balanced/t/extcbk.t
@@ -13,7 +13,7 @@ BEGIN {
 # 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..43\n"; }
+BEGIN { $| = 1; print "1..41\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( extract_codeblock );
 $loaded = 1;
@@ -40,7 +40,7 @@ while (defined($str = <DATA>))
 	my @res;
 	$var = eval "\@res = $cmd";
 	debug "\t   Failed: $@ at " . $@+0 .")" if $@;
-	debug "\t list got: [" . join("|",@res) . "]\n";
+	debug "\t list got: [" . join("|", map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
 	debug "\t list left: [$str]\n";
 	print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
 	print "ok ", $count++;
@@ -64,7 +64,6 @@ __DATA__
 
 # USING: extract_codeblock($str);
 { $data[4] =~ /['"]/; };
-{ case /^bar\s+\S+/ {\n#+\n}};
 
 # USING: extract_codeblock($str,'<>');
 < %x = ( try => "this") >;
diff --git a/lib/Text/Balanced/t/extmul.t b/lib/Text/Balanced/t/extmul.t
index 94699fa860..34207df2f3 100644
--- a/lib/Text/Balanced/t/extmul.t
+++ b/lib/Text/Balanced/t/extmul.t
@@ -13,7 +13,7 @@ BEGIN {
 # 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..86\n"; }
+BEGIN { $| = 1; print "1..85\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( :ALL );
 $loaded = 1;
@@ -316,10 +316,3 @@ expect	[ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
 
 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 --git a/lib/Text/Balanced/t/extqlk.t b/lib/Text/Balanced/t/extqlk.t
index e823e34b0e..1371a4ede7 100644
--- a/lib/Text/Balanced/t/extqlk.t
+++ b/lib/Text/Balanced/t/extqlk.t
@@ -14,7 +14,7 @@ BEGIN {
 # 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..95\n"; }
+BEGIN { $| = 1; print "1..85\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Text::Balanced qw ( extract_quotelike );
 $loaded = 1;
@@ -23,7 +23,6 @@ $count=2;
 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.
 
@@ -33,52 +32,36 @@ $neg = 0;
 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 }
-	my $setup_cmd = ($str =~ s/\A\{(.*)\}//) ? $1 : '';
-	my $tests = 'sl';
+	elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+	debug "\tUsing: $cmd\n";
+	debug "\t   on: [$str]\n";
 	$str =~ s/\\n/\n/g;
 	my $orig = $str;
 
-	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";
-	}
+	 my @res;
+	eval qq{\@res = $cmd; };
+	debug "\t  got:\n" . join "", map { ($res[$_]||="<undef>")=~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";
 }
 
-# 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);
@@ -92,16 +75,11 @@ __DATA__
 <<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
      <<EOHERE; done();\nline1\nline2\nEOHERE\n; next;
 <<"EOHERE"; done()\nline1\nline2\nEOHERE\n and next
-<<`EOHERE`; done()\nline1\nline2\nEOHERE\n and next
 <<'EOHERE'; done()\nline1\n'line2'\nEOHERE\n and next
 <<'EOHERE;'; done()\nline1\nline2\nEOHERE;\n and next
 <<"   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;
@@ -131,9 +109,6 @@ s/'/\\'/g;
 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 --git a/lib/Text/Balanced/t/exttag.t b/lib/Text/Balanced/t/exttag.t
index 79a4e2e793..d412c23ef3 100644
--- a/lib/Text/Balanced/t/exttag.t
+++ b/lib/Text/Balanced/t/exttag.t
@@ -39,7 +39,7 @@ while (defined($str = <DATA>))
 
 	my @res;
 	$var = eval "\@res = $cmd";
-	debug "\t list got: [" . join("|",@res) . "]\n";
+	debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
 	debug "\t list left: [$str]\n";
 	print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
 	print "ok ", $count++;
diff --git a/lib/Text/Balanced/t/extvar.t b/lib/Text/Balanced/t/extvar.t
index 2bda381b60..5f37d8c049 100644
--- a/lib/Text/Balanced/t/extvar.t
+++ b/lib/Text/Balanced/t/extvar.t
@@ -39,7 +39,7 @@ while (defined($str = <DATA>))
 
 	my @res;
 	$var = eval "\@res = $cmd";
-	debug "\t list got: [" . join("|",@res) . "]\n";
+	debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
 	debug "\t list left: [$str]\n";
 	print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
 	print "ok ", $count++;
diff --git a/lib/Text/Balanced/t/gentag.t b/lib/Text/Balanced/t/gentag.t
index 7b150a6ed5..f5fd5dcf0b 100644
--- a/lib/Text/Balanced/t/gentag.t
+++ b/lib/Text/Balanced/t/gentag.t
@@ -45,7 +45,7 @@ while (defined($str = <DATA>))
 
 	my @res;
 	$var = eval { @res = f($str) };
-	debug "\t list got: [" . join("|",@res) . "]\n";
+	debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n";
 	debug "\t list left: [$str]\n";
 	print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
 	print "ok ", $count++;
diff --git a/lib/Text/Balanced/t/pod-coverage.t b/lib/Text/Balanced/t/pod-coverage.t
new file mode 100755
index 0000000000..703f91de36
--- /dev/null
+++ b/lib/Text/Balanced/t/pod-coverage.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
diff --git a/lib/Text/Balanced/t/pod.t b/lib/Text/Balanced/t/pod.t
new file mode 100755
index 0000000000..976d7cdfb2
--- /dev/null
+++ b/lib/Text/Balanced/t/pod.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();