Change 29345 by [EMAIL PROTECTED] on 2006/11/22 09:56:14
- Restore two Text::Balanced tests, more comprehensive in bleadperl than
in CPAN.
- Restore a local bugfix, tested by the above tests.
- Fix a few typos in the POD for Text::Balanced
- Bump version of Text::Balanced
Affected files ...
... //depot/perl/lib/Text/Balanced.pm#17 edit
... //depot/perl/lib/Text/Balanced/t/extmul.t#7 edit
... //depot/perl/lib/Text/Balanced/t/extqlk.t#7 edit
Differences ...
==== //depot/perl/lib/Text/Balanced.pm#17 (text) ====
Index: perl/lib/Text/Balanced.pm
--- perl/lib/Text/Balanced.pm#16~29344~ 2006-11-22 01:12:16.000000000 -0800
+++ perl/lib/Text/Balanced.pm 2006-11-22 01:56:14.000000000 -0800
@@ -10,7 +10,7 @@
use SelfLoader;
use vars qw { $VERSION @ISA %EXPORT_TAGS };
-use version; $VERSION = qv('1.99.1');
+use version; $VERSION = qv('1.99.1_1');
@ISA = qw ( Exporter );
%EXPORT_TAGS = ( ALL => [ qw(
@@ -719,8 +719,7 @@
);
}
- unless ($$textref =~
- m{\G(\b(?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<(?=\s*["'A-Za-z_]))}gc)
+ unless ($$textref =~
m{\G(\b(?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<)}gc)
{
_failmsg q{No quotelike operator found after prefix at "} .
substr($$textref, pos($$textref), 20) .
@@ -1128,9 +1127,9 @@
current C<pos> location of the string's variable
(or at index zero, if no C<pos> position is defined).
In other words, the C<extract_...> subroutines I<don't>
-extract the first occurance of a substring anywhere
+extract the first occurrence of a substring anywhere
in a string (like an unanchored regex would). Rather,
-they extract an occurance of the substring appearing
+they extract an occurrence of the substring appearing
immediately at the current matching position in the
string (like a C<\G>-anchored regex would).
@@ -1396,7 +1395,7 @@
C<extract_variable> extracts any valid Perl variable or
variable-involved expression, including scalars, arrays, hashes, array
-accesses, hash look-ups, method calls through objects, subroutine calles
+accesses, hash look-ups, method calls through objects, subroutine calls
through subroutine references, etc.
The subroutine takes up to two optional arguments:
@@ -2055,7 +2054,7 @@
character is extracted from the start of the text and the extraction
subroutines reapplied. Characters which are thus removed are accumulated and
eventually become the next field (unless the fourth argument is true, in which
-case they are disgarded).
+case they are discarded).
For example, the following extracts substrings that are valid Perl variables:
==== //depot/perl/lib/Text/Balanced/t/extmul.t#7 (text) ====
Index: perl/lib/Text/Balanced/t/extmul.t
--- perl/lib/Text/Balanced/t/extmul.t#6~29344~ 2006-11-22 01:12:16.000000000
-0800
+++ perl/lib/Text/Balanced/t/extmul.t 2006-11-22 01:56:14.000000000 -0800
@@ -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,11 @@
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' ];
==== //depot/perl/lib/Text/Balanced/t/extqlk.t#7 (text) ====
Index: perl/lib/Text/Balanced/t/extqlk.t
--- perl/lib/Text/Balanced/t/extqlk.t#6~29344~ 2006-11-22 01:12:16.000000000
-0800
+++ perl/lib/Text/Balanced/t/extqlk.t 2006-11-22 01:56:14.000000000 -0800
@@ -14,15 +14,16 @@
# 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..95\n"; }
END {print "not ok 1\n" unless $loaded;}
use Text::Balanced qw ( extract_quotelike );
$loaded = 1;
print "ok 1\n";
$count=2;
use vars qw( $DEBUG );
-# $DEBUG=1;
-sub debug { print "\t>>>",@_ if $DEBUG }
+#$DEBUG=1;
+sub debug { print "\t>>>",@_ if $ENV{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 [EMAIL PROTECTED] = $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";
+ 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 [EMAIL PROTECTED] = $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);
@@ -75,11 +92,16 @@
<<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;
@@ -109,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 '->'
End of Patch.
