Change 13118 by jhi@alpha on 2001/11/20 02:58:38
Upgrade to Text::Balanced 1.89.
Affected files ...
.... //depot/perl/lib/Text/Balanced.pm#6 edit
.... //depot/perl/lib/Text/Balanced/Changes#2 edit
.... //depot/perl/lib/Text/Balanced/README#2 edit
.... //depot/perl/lib/Text/Balanced/t/extbrk.t#2 edit
.... //depot/perl/lib/Text/Balanced/t/extcbk.t#2 edit
.... //depot/perl/lib/Text/Balanced/t/extdel.t#2 edit
.... //depot/perl/lib/Text/Balanced/t/extmul.t#2 edit
.... //depot/perl/lib/Text/Balanced/t/extqlk.t#2 edit
.... //depot/perl/lib/Text/Balanced/t/exttag.t#2 edit
.... //depot/perl/lib/Text/Balanced/t/extvar.t#2 edit
.... //depot/perl/lib/Text/Balanced/t/gentag.t#2 edit
Differences ...
==== //depot/perl/lib/Text/Balanced.pm#6 (text) ====
Index: perl/lib/Text/Balanced.pm
--- perl/lib/Text/Balanced.pm.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced.pm Mon Nov 19 20:15:05 2001
@@ -10,7 +10,7 @@
use SelfLoader;
use vars qw { $VERSION @ISA %EXPORT_TAGS };
-$VERSION = '1.86';
+$VERSION = '1.89';
@ISA = qw ( Exporter );
%EXPORT_TAGS = ( ALL => [ qw(
@@ -429,6 +429,9 @@
sub _match_variable($$)
{
+# $#
+# $^
+# $$
my ($textref, $pre) = @_;
my $startpos = pos($$textref) = pos($$textref)||0;
unless ($$textref =~ m/\G($pre)/gc)
@@ -437,19 +440,24 @@
return;
}
my $varpos = pos($$textref);
- unless ($$textref =~ m/\G(\$#?|[*\@\%]|\\&)+/gc)
+ unless ($$textref =~ m{\G\$\s*(\d+|[][&`'+*./|,";%=~:?!\@<>()-]|\^[a-z]?)}gci)
{
+ unless ($$textref =~ m/\G((\$#?|[*\@\%]|\\&)+)/gc)
+ {
_failmsg "Did not find leading dereferencer", pos $$textref;
pos $$textref = $startpos;
return;
- }
+ }
+ my $deref = $1;
- unless ($$textref =~ m/\G\s*(?:::|')?(?:[_a-z]\w*(?:::|'))*[_a-z]\w*/gci
- or _match_codeblock($textref, "", '\{', '\}', '\{', '\}', 0))
- {
+ unless ($$textref =~ m/\G\s*(?:::|')?(?:[_a-z]\w*(?:::|'))*[_a-z]\w*/gci
+ or _match_codeblock($textref, "", '\{', '\}', '\{', '\}', 0)
+ or $deref eq '$#' or $deref eq '$$' )
+ {
_failmsg "Bad identifier after dereferencer", pos $$textref;
pos $$textref = $startpos;
return;
+ }
}
while (1)
@@ -854,13 +862,13 @@
my ($lastpos, $firstpos);
my @fields = ();
- for ($$textref)
+ #for ($$textref)
{
my @func = defined $_[1] ? @{$_[1]} : @{$def_func};
my $max = defined $_[2] && $_[2]>0 ? $_[2] : 1_000_000_000;
my $igunk = $_[3];
- pos ||= 0;
+ pos $$textref ||= 0;
unless (wantarray)
{
@@ -888,51 +896,57 @@
}
}
- FIELD: while (pos() < length())
+ FIELD: while (pos($$textref) < length($$textref))
{
my $field;
+ my @bits;
foreach my $i ( 0..$#func )
{
+ my $pref;
$func = $func[$i];
$class = $class[$i];
- $lastpos = pos;
+ $lastpos = pos $$textref;
if (ref($func) eq 'CODE')
- { ($field) = $func->($_) }
+ { ($field,undef,$pref) = @bits =
+$func->($$textref) }
elsif (ref($func) eq 'Text::Balanced::Extractor')
- { $field = $func->extract($_) }
- elsif( m/\G$func/gc )
- { $field = defined($1) ? $1 : $& }
-
+ { @bits = $field = $func->extract($$textref) }
+ elsif( $$textref =~ m/\G$func/gc )
+ { @bits = $field = defined($1) ? $1 : $& }
+ $pref ||= "";
if (defined($field) && length($field))
{
- if (defined($unkpos) && !$igunk)
- {
- push @fields, substr($_, $unkpos,
$lastpos-$unkpos);
- $firstpos = $unkpos unless defined
$firstpos;
- undef $unkpos;
- last FIELD if @fields == $max;
+ if (!$igunk) {
+ $unkpos = pos $$textref
+ if length($pref) &&
+!defined($unkpos);
+ if (defined $unkpos)
+ {
+ push @fields,
+substr($$textref, $unkpos, $lastpos-$unkpos).$pref;
+ $firstpos = $unkpos unless
+defined $firstpos;
+ undef $unkpos;
+ last FIELD if @fields == $max;
+ }
}
- push @fields, $class
- ? bless(\$field, $class)
+ push @fields, $class
+ ? bless (\$field, $class)
: $field;
$firstpos = $lastpos unless defined $firstpos;
- $lastpos = pos;
+ $lastpos = pos $$textref;
last FIELD if @fields == $max;
next FIELD;
}
}
- if (/\G(.)/gcs)
+ if ($$textref =~ /\G(.)/gcs)
{
- $unkpos = pos()-1
+ $unkpos = pos($$textref)-1
unless $igunk || defined $unkpos;
}
}
if (defined $unkpos)
{
- push @fields, substr($_, $unkpos);
+ push @fields, substr($$textref, $unkpos);
$firstpos = $unkpos unless defined $firstpos;
- $lastpos = length;
+ $lastpos = length $$textref;
}
last;
}
@@ -1925,13 +1939,18 @@
=back
The extraction process works by applying each extractor in
-sequence to the text string. If the extractor is a subroutine it
-is called in a list
-context and is expected to return a list of a single element, namely
-the extracted text.
-Note that the value returned by an extractor subroutine need not bear any
-relationship to the corresponding substring of the original text (see
-examples below).
+sequence to the text string.
+
+If the extractor is a subroutine it is called in a list context and is
+expected to return a list of a single element, namely the extracted
+text. It may optionally also return two further arguments: a string
+representing the text left after extraction (like $' for a pattern
+match), and a string representing any prefix skipped before the
+extraction (like $` in a pattern match). Note that this is designed
+to facilitate the use of other Text::Balanced subroutines with
+C<extract_multiple>. Note too that the value returned by an extractor
+subroutine need not bear any relationship to the corresponding substring
+of the original text (see examples below).
If the extractor is a precompiled regular expression or a string,
it is matched against the text in a scalar context with a leading
==== //depot/perl/lib/Text/Balanced/Changes#2 (text) ====
Index: perl/lib/Text/Balanced/Changes
--- perl/lib/Text/Balanced/Changes.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced/Changes Mon Nov 19 20:15:05 2001
@@ -246,3 +246,18 @@
- Consolidated POD in .pm file
- renamed tests to let DOS cope with them
+
+
+1.87 Thu Nov 15 21:25:35 2001
+
+ - Made extract_multiple aware of skipped prefixes returned
+ by subroutine extractors (such as extract_quotelike, etc.)
+
+ - Made extract_variable aware of punctuation variables
+
+ - Corified tests
+
+
+1.89 Sun Nov 18 22:49:50 2001
+
+ - Fixed extvar.t tests
==== //depot/perl/lib/Text/Balanced/README#2 (xtext) ====
Index: perl/lib/Text/Balanced/README
--- perl/lib/Text/Balanced/README.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced/README Mon Nov 19 20:15:05 2001
@@ -1,5 +1,5 @@
==============================================================================
- Release of version 1.86 of Text::Balanced
+ Release of version 1.89 of Text::Balanced
==============================================================================
@@ -66,14 +66,10 @@
==============================================================================
-CHANGES IN VERSION 1.86
+CHANGES IN VERSION 1.89
- - Revised licence for inclusion in core distribution
-
- - Consolidated POD in .pm file
-
- - renamed tests to let DOS cope with them
+ - Fixed extvar.t tests
==============================================================================
==== //depot/perl/lib/Text/Balanced/t/extbrk.t#2 (text) ====
Index: perl/lib/Text/Balanced/t/extbrk.t
--- perl/lib/Text/Balanced/t/extbrk.t.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced/t/extbrk.t Mon Nov 19 20:15:05 2001
@@ -1,3 +1,10 @@
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
==== //depot/perl/lib/Text/Balanced/t/extcbk.t#2 (text) ====
Index: perl/lib/Text/Balanced/t/extcbk.t
--- perl/lib/Text/Balanced/t/extcbk.t.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced/t/extcbk.t Mon Nov 19 20:15:05 2001
@@ -1,3 +1,10 @@
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
==== //depot/perl/lib/Text/Balanced/t/extdel.t#2 (text) ====
Index: perl/lib/Text/Balanced/t/extdel.t
--- perl/lib/Text/Balanced/t/extdel.t.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced/t/extdel.t Mon Nov 19 20:15:05 2001
@@ -1,3 +1,10 @@
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
==== //depot/perl/lib/Text/Balanced/t/extmul.t#2 (text) ====
Index: perl/lib/Text/Balanced/t/extmul.t
--- perl/lib/Text/Balanced/t/extmul.t.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced/t/extmul.t Mon Nov 19 20:15:05 2001
@@ -1,3 +1,10 @@
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
@@ -172,7 +179,7 @@
# TESTS 38-40
$text = $stdtext2;
expect [ extract_multiple($text,[\&extract_bracketed]) ],
- [ substr($stdtext2,0,15), substr($stdtext2,16,7), substr($stdtext2,23) ];
+ [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ];
expect [ pos $text], [ 24 ];
expect [ $text ], [ $stdtext2 ];
@@ -180,7 +187,7 @@
# TESTS 41-43
$text = $stdtext2;
expect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
- [ substr($stdtext2,0,15) ];
+ [ substr($stdtext2,0,16) ];
expect [ pos $text], [ 0 ];
expect [ $text ], [ substr($stdtext2,15) ];
@@ -206,7 +213,7 @@
# TESTS 50-52
$text = $stdtext2;
expect [ extract_multiple($text,[\&extract_quotelike]) ],
- [ substr($stdtext2,0,6), substr($stdtext2,7,5), substr($stdtext2,12) ];
+ [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ];
expect [ pos $text], [ length($text) ];
expect [ $text ], [ $stdtext2 ];
@@ -214,7 +221,7 @@
# TESTS 53-55
$text = $stdtext2;
expect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
- [ substr($stdtext2,0,6) ];
+ [ substr($stdtext2,0,7) ];
expect [ pos $text], [ 0 ];
expect [ $text ], [ substr($stdtext2,6) ];
==== //depot/perl/lib/Text/Balanced/t/extqlk.t#2 (text) ====
Index: perl/lib/Text/Balanced/t/extqlk.t
--- perl/lib/Text/Balanced/t/extqlk.t.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced/t/extqlk.t Mon Nov 19 20:15:05 2001
@@ -1,3 +1,10 @@
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
#! /usr/local/bin/perl -ws
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
==== //depot/perl/lib/Text/Balanced/t/exttag.t#2 (text) ====
Index: perl/lib/Text/Balanced/t/exttag.t
--- perl/lib/Text/Balanced/t/exttag.t.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced/t/exttag.t Mon Nov 19 20:15:05 2001
@@ -1,3 +1,10 @@
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
==== //depot/perl/lib/Text/Balanced/t/extvar.t#2 (text) ====
Index: perl/lib/Text/Balanced/t/extvar.t
--- perl/lib/Text/Balanced/t/extvar.t.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced/t/extvar.t Mon Nov 19 20:15:05 2001
@@ -1,3 +1,10 @@
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
@@ -6,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..81\n"; }
+BEGIN { $| = 1; print "1..181\n"; }
END {print "not ok 1\n" unless $loaded;}
use Text::Balanced qw ( extract_variable );
$loaded = 1;
@@ -58,6 +65,7 @@
$a (1..3) { print $a };
# USING: extract_variable($str);
+$obj->nextval;
*var;
*$var;
*{var};
@@ -91,6 +99,55 @@
$#array;
$#{array};
$var[$#var];
+$1;
+$11;
+$&;
+$`;
+$';
+$+;
+$*;
+$.;
+$/;
+$|;
+$,;
+$";
+$;;
+$#;
+$%;
+$=;
+$-;
+$~;
+$^;
+$:;
+$^L;
+$^A;
+$?;
+$!;
+$^E;
+$@;
+$$;
+$<;
+$>;
+$(;
+$);
+$[;
+$];
+$^C;
+$^D;
+$^F;
+$^H;
+$^I;
+$^M;
+$^O;
+$^P;
+$^R;
+$^S;
+$^T;
+$^V;
+$^W;
+${^WARNING_BITS};
+${^WIDE_SYSTEM_CALLS};
+$^X;
# THESE SHOULD FAIL
$a->;
==== //depot/perl/lib/Text/Balanced/t/gentag.t#2 (text) ====
Index: perl/lib/Text/Balanced/t/gentag.t
--- perl/lib/Text/Balanced/t/gentag.t.~1~ Mon Nov 19 20:15:05 2001
+++ perl/lib/Text/Balanced/t/gentag.t Mon Nov 19 20:15:05 2001
@@ -1,3 +1,10 @@
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir('t') if -d 't';
+ @INC = qw(../lib);
+ }
+}
+
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
End of Patch.
