This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Text-Balanced-1.98
authorSteve Peters <steve@fisharerojo.org>
Fri, 5 May 2006 12:40:41 +0000 (12:40 +0000)
committerSteve Peters <steve@fisharerojo.org>
Fri, 5 May 2006 12:40:41 +0000 (12:40 +0000)
p4raw-id: //depot/perl@28105

12 files changed:
MANIFEST
lib/Text/Balanced.pm
lib/Text/Balanced/Changes
lib/Text/Balanced/t/00.load.t [new file with mode: 0755]
lib/Text/Balanced/t/extcbk.t
lib/Text/Balanced/t/extmul.t
lib/Text/Balanced/t/extqlk.t
lib/Text/Balanced/t/exttag.t
lib/Text/Balanced/t/extvar.t
lib/Text/Balanced/t/gentag.t
lib/Text/Balanced/t/pod-coverage.t [new file with mode: 0755]
lib/Text/Balanced/t/pod.t [new file with mode: 0755]

index 5841f31..56ec439 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -2474,6 +2474,7 @@ lib/Text/Abbrev.t         Test Text::Abbrev
 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
@@ -2482,6 +2483,8 @@ lib/Text/Balanced/t/extqlk.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
index 297e8df..2c84a5a 100644 (file)
@@ -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
index c8c79fb..dfdae9a 100644 (file)
@@ -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 (executable)
index 0000000..79bc6f0
--- /dev/null
@@ -0,0 +1,7 @@
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'Text::Balanced' );
+}
+
+diag( "Testing Text::Balanced $Text::Balanced::VERSION" );
index 80553ab..30b7e50 100644 (file)
@@ -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") >;
index 94699fa..34207df 100644 (file)
@@ -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' ];
index e823e34..1371a4e 100644 (file)
@@ -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 '->'
index 79a4e2e..d412c23 100644 (file)
@@ -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++;
index 2bda381..5f37d8c 100644 (file)
@@ -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++;
index 7b150a6..f5fd5dc 100644 (file)
@@ -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 (executable)
index 0000000..703f91d
--- /dev/null
@@ -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 (executable)
index 0000000..976d7cd
--- /dev/null
@@ -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();