Integrate:

[ 22821]
make Text::Balanced skip "case /..../" correctly for Switch.pm

[ 25134]
Subject: [PATCH] #2 try at Text::Balanced patch and maintainership
From: Tels <nospam-abuse@bloodgate.com>
Date: Sat, 9 Jul 2005 23:10:29 +0200
Message-Id: <200507092310.30592@bloodgate.com>

(with minor tweaks)

[ 25135]
Subject: Re: [perl #25157] [PATCH] Text-Balanced extract_quotelike fails on certain delims in HERE docs
From: David Manura <dm.list@math2.org>
Date: Wed, 21 Jan 2004 20:59:27 -0500
Message-ID: <400F2E7F.9090601@math2.org>

Fixes perl #25151, 25154, 25156, 25157, 25158 using jumbo patch
included in perl #25157.

[ 28105]
Upgrade to Text-Balanced-1.98

[ 28125]
Rollback two changes in Text::Balanced which cause test failures in the
CPAN and bleadperl version of the tests.  Also, the previous bleadperl
version of one test file is a bit more comprehensive than what was in
CPAN, so it has been completely restored.

[ 28126]
Version bump and typo fix from change #28125.

[ 28127]
Rename lib/Text/Balanced/t/00.load.t to
lib/Text/Balanced/t/00-load.t and restore a test to
lib/Text/Balanced/t/extmul.t.

[ 28270]
Silence Text::Balanced's 00-load.t when PERL_CORE is defined.

[ 28287]
Fix a syntax error in test

[ 29344]
Sync Text::Balanced with the CPAN version (1.99.1)

[ 29345]
- 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

[ 29346]
Remove tests for POD or POD coverage -- they're always skipped.

[ 29609]
Upgrade to Text::Balanced 2.0.0
p4raw-link: @29609 on //depot/perl: 0c793b6f00b278111ed6958bc7f2b834f3da392c
p4raw-link: @29346 on //depot/perl: b0da272b8cf2101328dbfd44c99d70bb9ec9a586
p4raw-link: @29345 on //depot/perl: aa10195b3aa19bb4f167204cdce8fb75d361ccb8
p4raw-link: @29344 on //depot/perl: dd6316a97e0f719a4e6c5ff0736fa8b08b1b2337
p4raw-link: @28287 on //depot/perl: 20de43d3034ec586969afca80b4fd86708142401
p4raw-link: @28270 on //depot/perl: dc8f638738195a8f1d6774aa5a9874607346c798
p4raw-link: @28127 on //depot/perl: a646417951941146b1ea568de33ca3508b9859a2
p4raw-link: @28126 on //depot/perl: 62417cc93fa623269d060d8b3800f5a56316638d
p4raw-link: @28125 on //depot/perl: eb67bf7e7c7791f145451e273b36c197fb24fcb9
p4raw-link: @28105 on //depot/perl: 49c03c8934c87a2dcd3f60cea1f51beb84f61bd4
p4raw-link: @25135 on //depot/perl: ce3ac4b622fa47e8694929bdb9f342a59186d677
p4raw-link: @25134 on //depot/perl: 75c4c974b3d5cef5c6dab333977800a4ccd5a59f
p4raw-link: @22821 on //depot/perl: ce94069687f36a0b1d18574193627404340c135f

p4raw-id: //depot/maint-5.8/perl@30165
p4raw-branched: from //depot/perl@30164 'branch in'
	lib/Text/Balanced/t/00-load.t (@28270..)
p4raw-deleted: from //depot/perl@30164 'delete in'
	lib/Test/Harness/t/pod.t (@21826..)
p4raw-integrated: from //depot/perl@30164 'copy in'
	lib/Text/Balanced/t/exttag.t (@13118..)
	lib/Text/Balanced/t/extvar.t lib/Text/Balanced/t/gentag.t
	(@19989..) lib/Text/Balanced/README (@29344..)
p4raw-integrated: from //depot/perl@29346 'edit in' MANIFEST (@29320..)
p4raw-integrated: from //depot/perl@29344 'ignore'
	lib/Text/Balanced/Changes (@28105..)
p4raw-branched: from //depot/perl@28105 'branch in'
	lib/Text/Balanced/t/00.load.t
	lib/Text/Balanced/t/pod-coverage.t lib/Text/Balanced/t/pod.t
p4raw-integrated: from //depot/perl@28105 'ignore'
	lib/Text/Balanced/t/extmul.t lib/Text/Balanced/t/extqlk.t
	(@25135..)
p4raw-integrated: from //depot/perl@25134 'edit in'
	lib/Text/Balanced.pm (@22821..)
p4raw-integrated: from //depot/perl@22821 'ignore'
	lib/Text/Balanced/t/extcbk.t (@19989..)

diff --git a/MANIFEST b/MANIFEST
index d363870..6a60143 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1901,7 +1901,6 @@ lib/Test/Harness/t/harness.t      Test::Harness test
 lib/Test/Harness/t/inc_taint.t Test::Harness test
 lib/Test/Harness/t/nonumbers.t Test::Harness test
 lib/Test/Harness/t/ok.t                Test::Harness test
-lib/Test/Harness/t/pod.t       Test::Harness test
 lib/Test/Harness/t/point-parse.t       Test::Harness test
 lib/Test/Harness/t/point.t     Test::Harness test
 lib/Test/Harness/t/prove-globbing.t    Test::Harness::Straps test
@@ -1995,6 +1994,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
@@ -2003,6 +2003,7 @@ 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/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

diff --git a/lib/Test/Harness/t/pod.t b/lib/Test/Harness/t/pod.t
deleted file mode 100644 (file)
index 38d72b1..0000000
--- a/lib/Test/Harness/t/pod.t
+++ /dev/null
@@ -1,14 +0,0 @@
-BEGIN {
-    if( $ENV{PERL_CORE} ) {
-        chdir 't';
-        @INC = ('../lib', 'lib');
-    }
-    else {
-        unshift @INC, 't/lib';
-    }
-}
-
-use Test::More;
-eval "use Test::Pod 1.00";
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
-all_pod_files_ok();

diff --git a/lib/Text/Balanced.pm b/lib/Text/Balanced.pm
index 820ae25..948dcd1 100644 (file)
--- a/lib/Text/Balanced.pm
+++ b/lib/Text/Balanced.pm
@@ -10,7 +10,10 @@ use Exporter;
 use SelfLoader;
 use vars qw { $VERSION @ISA %EXPORT_TAGS };
 
-$VERSION = '1.95';
+# 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;
 @ISA           = qw ( Exporter );
                     
 %EXPORT_TAGS   = ( ALL => [ qw(
@@ -48,7 +51,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;
 }
 
@@ -57,7 +60,7 @@ sub _succeed
        $@ = undef;
        my ($wantarray,$textref) = splice @_, 0, 2;
        my ($extrapos, $extralen) = @_>18 ? splice(@_, -2, 2) : (0,0);
-       my ($startlen) = $_[5];
+       my ($startlen, $oppos) = @_[5,6];
        my $remainderpos = $_[2];
        if ($wantarray)
        {
@@ -67,7 +70,7 @@ sub _succeed
                        push @res, substr($$textref,$from,$len);
                }
                if ($extralen) {        # CORRECT FILLET
-                       my $extra = substr($res[0], $extrapos-$startlen, $extralen, "\n");
+                       my $extra = substr($res[0], $extrapos-$oppos, $extralen, "\n");
                        $res[1] = "$extra$res[1]";
                        eval { substr($$textref,$remainderpos,0) = $extra;
                               substr($$textref,$extrapos,$extralen,"\n")} ;
@@ -266,7 +269,7 @@ sub _match_bracketed($$$$$$)        # $textref, $pre, $ldel, $qdel, $quotelike, $rdel
               );
 }
 
-sub revbracket($)
+sub _revbracket($)
 {
        my $brack = reverse $_[0];
        $brack =~ tr/[({</])}>/;
@@ -328,8 +331,8 @@ sub _match_tagged   # ($$$$$$$)
 
        if (!defined $rdel)
        {
-               $rdelspec = $&;
-               unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". revbracket($1) /oes)
+               $rdelspec = substr($$textref, $-[0], $+[0] - $-[0]);
+               unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". _revbracket($1) /oes)
                {
                        _failmsg "Unable to construct closing tag to match: $rdel",
                                 pos $$textref;
@@ -748,8 +751,8 @@ sub _match_quotelike($$$$)  # ($textref, $prepat, $allow_raw_match)
                }
                my $extrapos = pos($$textref);
                $$textref =~ m{.*\n}gc;
-               $str1pos = pos($$textref);
-               unless ($$textref =~ m{.*?\n(?=$label\n)}gc) {
+               $str1pos = pos($$textref)--;
+               unless ($$textref =~ m{.*?\n(?=\Q$label\E\n)}gc) {
                        _failmsg qq{Missing here doc terminator ('$label') after "} .
                                     substr($$textref, $startpos, 20) .
                                     q{..."},
@@ -758,7 +761,7 @@ sub _match_quotelike($$$$)  # ($textref, $prepat, $allow_raw_match)
                        return;
                }
                $rd1pos = pos($$textref);
-               $$textref =~ m{$label\n}gc;
+        $$textref =~ m{\Q$label\E\n}gc;
                $ld2pos = pos($$textref);
                return (
                        $startpos,      $oppos-$startpos,       # PREFIX
@@ -791,15 +794,17 @@ sub _match_quotelike($$$$)        # ($textref, $prepat, $allow_raw_match)
        if ($ldel1 =~ /[[(<{]/)
        {
                $rdel1 =~ tr/[({</])}>/;
-               _match_bracketed($textref,"",$ldel1,"","",$rdel1)
+               defined(_match_bracketed($textref,"",$ldel1,"","",$rdel1))
                || do { pos $$textref = $startpos; return };
+        $ld2pos = pos($$textref);
+        $rd1pos = $ld2pos-1;
        }
        else
        {
-               $$textref =~ /$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs
+               $$textref =~ /\G$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)
@@ -826,7 +831,7 @@ sub _match_quotelike($$$$)  # ($textref, $prepat, $allow_raw_match)
                if ($ldel2 =~ /[[(<{]/)
                {
                        pos($$textref)--;       # OVERCOME BROKEN LOOKAHEAD 
-                       _match_bracketed($textref,"",$ldel2,"","",$rdel2)
+                       defined(_match_bracketed($textref,"",$ldel2,"","",$rdel2))
                        || do { pos $$textref = $startpos; return };
                }
                else
@@ -919,18 +924,19 @@ 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 )
-                                       { @bits = $field = defined($1) ? $1 : $& }
+                                       { @bits = $field = defined($1)
+                                ? $1
+                                : substr($$textref, $-[0], $+[0] - $-[0])
+                    }
                                $pref ||= "";
                                if (defined($field) && length($field))
                                {
                                        if (!$igunk) {
-                                               $unkpos = pos $$textref
+                                               $unkpos = $lastpos
                                                        if length($pref) && !defined($unkpos);
                                                if (defined $unkpos)
                                                {
@@ -1126,9 +1132,9 @@ The substring to be extracted must appear at the
 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).
 
@@ -1144,7 +1150,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]
 
@@ -1154,7 +1160,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 
 
@@ -1394,7 +1400,7 @@ See also: C<"extract_quotelike"> and C<"extract_codeblock">.
 
 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:
@@ -2053,7 +2059,7 @@ If none of the extractor subroutines succeeds, then one
 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:
 
@@ -2140,9 +2146,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

diff --git a/lib/Text/Balanced/Changes b/lib/Text/Balanced/Changes
index c8c79fb..49957dc 100644 (file)
--- a/lib/Text/Balanced/Changes
+++ b/lib/Text/Balanced/Changes
@@ -299,3 +299,44 @@ 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!)
+
+
+
+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)

diff --git a/lib/Text/Balanced/README b/lib/Text/Balanced/README
index 032bb23..386bd5a 100755 (executable)
--- a/lib/Text/Balanced/README
+++ b/lib/Text/Balanced/README
@@ -1,14 +1,8 @@
-==============================================================================
-                  Release of version 1.95 of Text::Balanced
-==============================================================================
-
-
-NAME
+Text::Balanced version 2.0.0
 
     Text::Balanced - Extract delimited text sequences from strings.
 
-
-SUMMARY (see Balanced.pod for full details)
+SUMMARY
 
     Text::Balanced::extract_delimited
     
@@ -42,42 +36,36 @@ SUMMARY (see Balanced.pod for full details)
     
         `extract_tagged' attempts to recognize and extract a
         substring between two arbitrary "tag" patterns (a start tag
-       and an end tag).
-
-    
-INSTALLATION
-
-    It's all pure Perl, so just put the .pm file in its appropriate
-    local Perl subdirectory.
-
+       and an end tag).
 
-AUTHOR
-
-    Damian Conway (damian@cs.monash.edu.au)
 
+INSTALLATION
 
-COPYRIGHT
+To install this module, run the following commands:
 
-     Copyright (c) 1997-2001, Damian Conway. All Rights Reserved.
-     This module is free software. It may be used, redistributed
-         and/or modified under the same terms as Perl itself.
+    perl Makefile.PL
+    make
+    make test
+    make install
 
 
+Alternatively, to install with Module::Build, you can use the following commands:
 
-==============================================================================
+    perl Build.PL
+    ./Build
+    ./Build test
+    ./Build install
 
-CHANGES IN VERSION 1.95
 
 
-       - Constrainted _match_quote to only match at word boundaries
-         (so "exemplum(hic)" doesn't match "m(hic)")
-         (thanks Craig)
+DEPENDENCIES
 
+None.
 
-==============================================================================
 
-AVAILABILITY
+COPYRIGHT AND LICENCE
 
-Text::Balanced has been uploaded to the CPAN
+Copyright (C) 2006, Damian Conway
 
-==============================================================================
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.

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..a8268a7
--- /dev/null
+++ b/lib/Text/Balanced/t/00-load.t
@@ -0,0 +1,7 @@
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'Text::Balanced' );
+diag( "Testing Text::Balanced $Text::Balanced::VERSION" )
+    unless $ENV{PERL_CORE};
+}

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
+++ b/lib/Text/Balanced/t/00.load.t
@@ -0,0 +1,7 @@
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'Text::Balanced' );
+}
+
+diag( "Testing Text::Balanced $Text::Balanced::VERSION" );

diff --git a/lib/Text/Balanced/t/extcbk.t b/lib/Text/Balanced/t/extcbk.t
index 47b0045..30b7e50 100644 (file)
--- a/lib/Text/Balanced/t/extcbk.t
+++ b/lib/Text/Balanced/t/extcbk.t
@@ -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++;

diff --git a/lib/Text/Balanced/t/extmul.t b/lib/Text/Balanced/t/extmul.t
index 34207df..98b6272 100644 (file)
--- a/lib/Text/Balanced/t/extmul.t
+++ b/lib/Text/Balanced/t/extmul.t
@@ -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..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     [ 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' ];

diff --git a/lib/Text/Balanced/t/extqlk.t b/lib/Text/Balanced/t/extqlk.t
index b5d9fe6..97dc517 100644 (file)
--- a/lib/Text/Balanced/t/extqlk.t
+++ b/lib/Text/Balanced/t/extqlk.t
@@ -14,15 +14,16 @@ 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..89\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||'<undef>'; $x =~ s/\n/\\n/gs; $x }
 
 ######################### End of black magic.
 
@@ -32,36 +33,52 @@ $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 }
-       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 qq{\@res = $cmd; };
-       debug "\t  got:\n" . join "", map { $res[$_]=~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 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";
+       }
 }
 
+# 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);
@@ -81,7 +98,10 @@ __DATA__
 <<"   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;
@@ -111,6 +131,9 @@ 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 '->'

diff --git a/lib/Text/Balanced/t/exttag.t b/lib/Text/Balanced/t/exttag.t
index 79a4e2e..d412c23 100644 (file)
--- a/lib/Text/Balanced/t/exttag.t
+++ b/lib/Text/Balanced/t/exttag.t
@@ -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++;

diff --git a/lib/Text/Balanced/t/extvar.t b/lib/Text/Balanced/t/extvar.t
index 2bda381..5f37d8c 100644 (file)
--- a/lib/Text/Balanced/t/extvar.t
+++ b/lib/Text/Balanced/t/extvar.t
@@ -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++;

diff --git a/lib/Text/Balanced/t/gentag.t b/lib/Text/Balanced/t/gentag.t
index 7b150a6..f5fd5dc 100644 (file)
--- a/lib/Text/Balanced/t/gentag.t
+++ b/lib/Text/Balanced/t/gentag.t
@@ -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
+++ b/lib/Text/Balanced/t/pod-coverage.t
@@ -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
+++ b/lib/Text/Balanced/t/pod.t
@@ -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();