Change 32984 by [EMAIL PROTECTED] on 2008/01/16 15:21:04
Up*grade to Text::Balanced 1.98, which is the most recent version that
does not require version.pm.
* for some value of gravity.
Affected files ...
... //depot/maint-5.8/perl/lib/Text/Balanced.pm#4 edit
... //depot/maint-5.8/perl/lib/Text/Balanced/Changes#4 edit
... //depot/maint-5.8/perl/lib/Text/Balanced/README#4 edit
... //depot/maint-5.8/perl/lib/Text/Balanced/t/00-load.t#2 edit
... //depot/maint-5.8/perl/lib/Text/Balanced/t/extmul.t#3 edit
... //depot/maint-5.8/perl/lib/Text/Balanced/t/extqlk.t#3 edit
Differences ...
==== //depot/maint-5.8/perl/lib/Text/Balanced.pm#4 (text) ====
Index: perl/lib/Text/Balanced.pm
--- perl/lib/Text/Balanced.pm#3~30165~ 2007-02-07 14:21:00.000000000 -0800
+++ perl/lib/Text/Balanced.pm 2008-01-16 07:21:04.000000000 -0800
@@ -10,10 +10,7 @@
use SelfLoader;
use vars qw { $VERSION @ISA %EXPORT_TAGS };
-# I really don't want to bring the XS version module into maint. So for now,
-# I'm commiting the sin of Bowdlerising Damian's module:
-# use version; $VERSION = qv('2.0.0');
-$VERSION = 2.000000;
+$VERSION = 1.98;
@ISA = qw ( Exporter );
%EXPORT_TAGS = ( ALL => [ qw(
@@ -331,7 +328,7 @@
if (!defined $rdel)
{
- $rdelspec = substr($$textref, $-[0], $+[0] - $-[0]);
+ $rdelspec = $&;
unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta
"$1\/$2". _revbracket($1) /oes)
{
_failmsg "Unable to construct closing tag to match:
$rdel",
@@ -722,7 +719,8 @@
);
}
- 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) .
@@ -796,15 +794,13 @@
$rdel1 =~ tr/[({</])}>/;
defined(_match_bracketed($textref,"",$ldel1,"","",$rdel1))
|| do { pos $$textref = $startpos; return };
- $ld2pos = pos($$textref);
- $rd1pos = $ld2pos-1;
}
else
{
- $$textref =~ /\G$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs
+ $$textref =~ /$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs
|| do { pos $$textref = $startpos; return };
- $ld2pos = $rd1pos = pos($$textref)-1;
}
+ $ld2pos = $rd1pos = pos($$textref)-1;
my $second_arg = $op =~ /s|tr|y/ ? 1 : 0;
if ($second_arg)
@@ -928,10 +924,7 @@
elsif (ref($func) eq
'Text::Balanced::Extractor')
{ @bits = $field =
$func->extract($$textref) }
elsif( $$textref =~ m/\G$func/gc )
- { @bits = $field = defined($1)
- ? $1
- : substr($$textref, $-[0], $+[0] - $-[0])
- }
+ { @bits = $field = defined($1) ? $1 :
$& }
$pref ||= "";
if (defined($field) && length($field))
{
@@ -1132,9 +1125,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 occurrence of a substring anywhere
+extract the first occurance of a substring anywhere
in a string (like an unanchored regex would). Rather,
-they extract an occurrence of the substring appearing
+they extract an occurance of the substring appearing
immediately at the current matching position in the
string (like a C<\G>-anchored regex would).
@@ -1400,7 +1393,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 calls
+accesses, hash look-ups, method calls through objects, subroutine calles
through subroutine references, etc.
The subroutine takes up to two optional arguments:
@@ -2059,7 +2052,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 discarded).
+case they are disgarded).
For example, the following extracts substrings that are valid Perl variables:
==== //depot/maint-5.8/perl/lib/Text/Balanced/Changes#4 (text) ====
Index: perl/lib/Text/Balanced/Changes
--- perl/lib/Text/Balanced/Changes#3~30165~ 2007-02-07 14:21:00.000000000
-0800
+++ perl/lib/Text/Balanced/Changes 2008-01-16 07:21:04.000000000 -0800
@@ -319,24 +319,3 @@
1.98 Fri May 5 14:58:49 2006
- Reinstated full test suite (thanks Steve!)
-
-
-
-1.99.0 Thu Nov 16 07:32:06 2006
-
- - Removed reliance on expensive $& variable (thanks John)
-
- - Made Makefile.PL play nice with core versions (thanks Schwern!)
-
-
-1.99.1 Thu Nov 16 09:29:14 2006
-
- - Included dependency on version.pm (thanks Andy)
-
-
-
-2.0.0 Wed Dec 20 10:50:24 2006
-
- - Added patches from bleadperl version (thanks Rafael!)
-
- - Fixed bug in second bracketed delimiters (thanks David)
==== //depot/maint-5.8/perl/lib/Text/Balanced/README#4 (xtext) ====
Index: perl/lib/Text/Balanced/README
--- perl/lib/Text/Balanced/README#3~30165~ 2007-02-07 14:21:00.000000000
-0800
+++ perl/lib/Text/Balanced/README 2008-01-16 07:21:04.000000000 -0800
@@ -1,4 +1,4 @@
-Text::Balanced version 2.0.0
+Text::Balanced version 1.98
Text::Balanced - Extract delimited text sequences from strings.
==== //depot/maint-5.8/perl/lib/Text/Balanced/t/00-load.t#2 (xtext) ====
Index: perl/lib/Text/Balanced/t/00-load.t
--- perl/lib/Text/Balanced/t/00-load.t#1~30165~ 2007-02-07 14:21:00.000000000
-0800
+++ perl/lib/Text/Balanced/t/00-load.t 2008-01-16 07:21:04.000000000 -0800
@@ -2,6 +2,6 @@
BEGIN {
use_ok( 'Text::Balanced' );
-diag( "Testing Text::Balanced $Text::Balanced::VERSION" )
- unless $ENV{PERL_CORE};
}
+
+diag( "Testing Text::Balanced $Text::Balanced::VERSION" );
==== //depot/maint-5.8/perl/lib/Text/Balanced/t/extmul.t#3 (text) ====
Index: perl/lib/Text/Balanced/t/extmul.t
--- perl/lib/Text/Balanced/t/extmul.t#2~30165~ 2007-02-07 14:21:00.000000000
-0800
+++ perl/lib/Text/Balanced/t/extmul.t 2008-01-16 07:21:04.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..86\n"; }
+BEGIN { $| = 1; print "1..85\n"; }
END {print "not ok 1\n" unless $loaded;}
use Text::Balanced qw ( :ALL );
$loaded = 1;
@@ -316,11 +316,3 @@
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/maint-5.8/perl/lib/Text/Balanced/t/extqlk.t#3 (text) ====
Index: perl/lib/Text/Balanced/t/extqlk.t
--- perl/lib/Text/Balanced/t/extqlk.t#2~30165~ 2007-02-07 14:21:00.000000000
-0800
+++ perl/lib/Text/Balanced/t/extqlk.t 2008-01-16 07:21:04.000000000 -0800
@@ -14,16 +14,15 @@
# 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;
print "ok 1\n";
$count=2;
use vars qw( $DEBUG );
-#$DEBUG=1;
-sub debug { print "\t>>>",@_ if $ENV{DEBUG} }
-sub esc { my $x = shift||'<undef>'; $x =~ s/\n/\\n/gs; $x }
+# $DEBUG=1;
+sub debug { print "\t>>>",@_ if $DEBUG }
######################### End of black magic.
@@ -33,52 +32,36 @@
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 [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";
- }
+ 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";
}
-# 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 @@
<<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 @@
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.
