lib/Text/Balanced/Changes Text::Balanced
lib/Text/Balanced.pm Text::Balanced
lib/Text/Balanced/README Text::Balanced
+lib/Text/Balanced/t/00.load.t See if Text::Balanced works
lib/Text/Balanced/t/extbrk.t See if Text::Balanced works
lib/Text/Balanced/t/extcbk.t See if Text::Balanced works
lib/Text/Balanced/t/extdel.t See if Text::Balanced works
lib/Text/Balanced/t/exttag.t See if Text::Balanced works
lib/Text/Balanced/t/extvar.t See if Text::Balanced works
lib/Text/Balanced/t/gentag.t See if Text::Balanced works
+lib/Text/Balanced/t/pod.t See if Text::Balanced works
+lib/Text/Balanced/t/pod-coverage.t See if Text::Balanced works
lib/Text/ParseWords.pm Perl module to split words on arbitrary delimiter
lib/Text/ParseWords.t See if Text::ParseWords works
lib/Text/ParseWords/taint.t See if Text::ParseWords works with tainting
use Exporter;
use vars qw { $VERSION @ISA %EXPORT_TAGS };
-$VERSION = '1.95_01';
+$VERSION = '1.97';
@ISA = qw ( Exporter );
%EXPORT_TAGS = ( ALL => [ qw(
{
my ($wantarray, $textref, $message, $pos) = @_;
_failmsg $message, $pos if $message;
- return ("",$$textref,"") if $wantarray;
+ return (undef,$$textref,undef) if $wantarray;
return undef;
}
$@ = 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)
{
);
}
-sub revbracket($)
+sub _revbracket($)
{
my $brack = reverse $_[0];
$brack =~ tr/[({</])}>/;
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;
);
}
- 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) .
$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 )
=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]
=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
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
- 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!)
--- /dev/null
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'Text::Balanced' );
+}
+
+diag( "Testing Text::Balanced $Text::Balanced::VERSION" );
# 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;
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++;
# USING: extract_codeblock($str);
{ $data[4] =~ /['"]/; };
-{ case /^bar\s+\S+/ {\n#+\n}};
# USING: extract_codeblock($str,'<>');
< %x = ( try => "this") >;
# 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;
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' ];
# 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;
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.
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);
<<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;
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 '->'
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++;
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++;
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++;
--- /dev/null
+#!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();
--- /dev/null
+#!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();
projects / p5sagit/p5-mst-13.2.git / commitdiff