summaryrefslogtreecommitdiff
path: root/cpan/Text-Balanced/t
diff options
context:
space:
mode:
Diffstat (limited to 'cpan/Text-Balanced/t')
-rw-r--r--cpan/Text-Balanced/t/01_compile.t11
-rw-r--r--cpan/Text-Balanced/t/02_extbrk.t76
-rw-r--r--cpan/Text-Balanced/t/03_extcbk.t95
-rw-r--r--cpan/Text-Balanced/t/04_extdel.t90
-rw-r--r--cpan/Text-Balanced/t/05_extmul.t319
-rw-r--r--cpan/Text-Balanced/t/06_extqlk.t135
-rw-r--r--cpan/Text-Balanced/t/07_exttag.t113
-rw-r--r--cpan/Text-Balanced/t/08_extvar.t153
-rw-r--r--cpan/Text-Balanced/t/09_gentag.t102
9 files changed, 1094 insertions, 0 deletions
diff --git a/cpan/Text-Balanced/t/01_compile.t b/cpan/Text-Balanced/t/01_compile.t
new file mode 100644
index 0000000000..77c1099995
--- /dev/null
+++ b/cpan/Text-Balanced/t/01_compile.t
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
+use Test::More tests => 1;
+
+use_ok( 'Text::Balanced' );
diff --git a/cpan/Text-Balanced/t/02_extbrk.t b/cpan/Text-Balanced/t/02_extbrk.t
new file mode 100644
index 0000000000..a36025ddb0
--- /dev/null
+++ b/cpan/Text-Balanced/t/02_extbrk.t
@@ -0,0 +1,76 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# 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..19\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_bracketed );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+ chomp $str;
+ 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 }
+ $str =~ s/\\n/\n/g;
+ debug "\tUsing: $cmd\n";
+ debug "\t on: [$str]\n";
+
+ $var = eval "() = $cmd";
+ debug "\t list got: [$var]\n";
+ debug "\t list left: [$str]\n";
+ print "not " if (substr($str,pos($str),1) eq ';')==$neg;
+ print "ok ", $count++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+
+ pos $str = 0;
+ $var = eval $cmd;
+ $var = "<undef>" unless defined $var;
+ debug "\t scalar got: [$var]\n";
+ debug "\t scalar left: [$str]\n";
+ print "not " if ($str =~ '\A;')==$neg;
+ print "ok ", $count++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+}
+
+__DATA__
+
+# USING: extract_bracketed($str);
+{a nested { and } are okay as are () and <> pairs and escaped \}'s };
+{a nested\n{ and } are okay as are\n() and <> pairs and escaped \}'s };
+
+# USING: extract_bracketed($str,'{}');
+{a nested { and } are okay as are unbalanced ( and < pairs and escaped \}'s };
+
+# THESE SHOULD FAIL
+{an unmatched nested { isn't okay, nor are ( and < };
+{an unbalanced nested [ even with } and ] to match them;
+
+
+# USING: extract_bracketed($str,'<"`q>');
+<a q{uoted} ">" unbalanced right bracket of /(q>)/ either sort (`>>>""">>>>`) is okay >;
+
+# USING: extract_bracketed($str,'<">');
+<a quoted ">" unbalanced right bracket is okay >;
+
+# USING: extract_bracketed($str,'<"`>');
+<a quoted ">" unbalanced right bracket of either sort (`>>>""">>>>`) is okay >;
+
+# THIS SHOULD FAIL
+<a misquoted '>' unbalanced right bracket is bad >;
diff --git a/cpan/Text-Balanced/t/03_extcbk.t b/cpan/Text-Balanced/t/03_extcbk.t
new file mode 100644
index 0000000000..83081ae28d
--- /dev/null
+++ b/cpan/Text-Balanced/t/03_extcbk.t
@@ -0,0 +1,95 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# 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..41\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_codeblock );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+ chomp $str;
+ 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 }
+ $str =~ s/\\n/\n/g;
+ debug "\tUsing: $cmd\n";
+ debug "\t on: [$str]\n";
+
+ my @res;
+ $var = eval "\@res = $cmd";
+ debug "\t Failed: $@ at " . $@+0 .")" if $@;
+ 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++;
+ print "\n";
+
+ pos $str = 0;
+ $var = eval $cmd;
+ $var = "<undef>" unless defined $var;
+ debug "\t scalar got: [$var]\n";
+ debug "\t scalar left: [$str]\n";
+ print "not " if ($str =~ '\A;')==$neg;
+ print "ok ", $count++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+}
+
+__DATA__
+
+# USING: extract_codeblock($str,'(){}',undef,'()');
+(Foo(')'));
+
+# USING: extract_codeblock($str);
+{ $data[4] =~ /['"]/; };
+
+# USING: extract_codeblock($str,'<>');
+< %x = ( try => "this") >;
+< %x = () >;
+< %x = ( $try->{this}, "too") >;
+< %'x = ( $try->{this}, "too") >;
+< %'x'y = ( $try->{this}, "too") >;
+< %::x::y = ( $try->{this}, "too") >;
+
+# THIS SHOULD FAIL
+< %x = do { $try > 10 } >;
+
+# USING: extract_codeblock($str);
+
+{ $a = /\}/; };
+{ sub { $_[0] /= $_[1] } }; # / here
+{ 1; };
+{ $a = 1; };
+
+
+# USING: extract_codeblock($str,undef,'=*');
+========{$a=1};
+
+# USING: extract_codeblock($str,'{}<>');
+< %x = do { $try > 10 } >;
+
+# USING: extract_codeblock($str,'{}',undef,'<>');
+< %x = do { $try > 10 } >;
+
+# USING: extract_codeblock($str,'{}');
+{ $a = $b; # what's this doing here? \n };'
+{ $a = $b; \n $a =~ /$b/; \n @a = map /\s/ @b };
+
+# THIS SHOULD FAIL
+{ $a = $b; # what's this doing here? };'
+{ $a = $b; # what's this doing here? ;'
diff --git a/cpan/Text-Balanced/t/04_extdel.t b/cpan/Text-Balanced/t/04_extdel.t
new file mode 100644
index 0000000000..c5ca88eebf
--- /dev/null
+++ b/cpan/Text-Balanced/t/04_extdel.t
@@ -0,0 +1,90 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# 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..45\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_delimited );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+ chomp $str;
+ 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 }
+ $str =~ s/\\n/\n/g;
+ debug "\tUsing: $cmd\n";
+ debug "\t on: [$str]\n";
+
+ $var = eval "() = $cmd";
+ debug "\t list got: [$var]\n";
+ debug "\t list left: [$str]\n";
+ print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
+ print "ok ", $count++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+
+ pos $str = 0;
+ $var = eval $cmd;
+ $var = "<undef>" unless defined $var;
+ debug "\t scalar got: [$var]\n";
+ debug "\t scalar left: [$str]\n";
+ print "not " if ($str =~ '\A;')==$neg;
+ print "ok ", $count++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+}
+
+__DATA__
+# USING: extract_delimited($str,'/#$',undef,'/#$');
+/a/;
+/a///;
+#b#;
+#b###;
+$c$;
+$c$$$;
+
+# TEST EXTRACTION OF DELIMITED TEXT WITH ESCAPES
+# USING: extract_delimited($str,'/#$',undef,'\\');
+/a/;
+/a\//;
+#b#;
+#b\##;
+$c$;
+$c\$$;
+
+# TEST EXTRACTION OF DELIMITED TEXT
+# USING: extract_delimited($str);
+'a';
+"b";
+`c`;
+'a\'';
+'a\\';
+'\\a';
+"a\\";
+"\\a";
+"b\'\"\'";
+`c '\`abc\`'`;
+
+# TEST EXTRACTION OF DELIMITED TEXT
+# USING: extract_delimited($str,'/#$','-->');
+-->/a/;
+-->#b#;
+-->$c$;
+
+# THIS SHOULD FAIL
+$c$;
diff --git a/cpan/Text-Balanced/t/05_extmul.t b/cpan/Text-Balanced/t/05_extmul.t
new file mode 100644
index 0000000000..2ac1b19ffd
--- /dev/null
+++ b/cpan/Text-Balanced/t/05_extmul.t
@@ -0,0 +1,319 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# 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"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( :ALL );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+sub expect
+{
+ local $^W;
+ my ($l1, $l2) = @_;
+
+ if (@$l1 != @$l2)
+ {
+ print "\@l1: ", join(", ", @$l1), "\n";
+ print "\@l2: ", join(", ", @$l2), "\n";
+ print "not ";
+ }
+ else
+ {
+ for (my $i = 0; $i < @$l1; $i++)
+ {
+ if ($l1->[$i] ne $l2->[$i])
+ {
+ print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n";
+ print "not ";
+ last;
+ }
+ }
+ }
+
+ print "ok $count\n";
+ $count++;
+}
+
+sub divide
+{
+ my ($text, @index) = @_;
+ my @bits = ();
+ unshift @index, 0;
+ push @index, length($text);
+ for ( my $i= 0; $i < $#index; $i++)
+ {
+ push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]);
+ }
+ pop @bits;
+ return @bits;
+
+}
+
+
+$stdtext1 = q{$var = do {"val" && $val;};};
+
+# TESTS 2-4
+$text = $stdtext1;
+expect [ extract_multiple($text,undef,1) ],
+ [ divide $stdtext1 => 4 ];
+
+expect [ pos $text], [ 4 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 5-7
+$text = $stdtext1;
+expect [ scalar extract_multiple($text,undef,1) ],
+ [ divide $stdtext1 => 4 ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 8-10
+$text = $stdtext1;
+expect [ extract_multiple($text,undef,2) ],
+ [ divide($stdtext1 => 4, 10) ];
+
+expect [ pos $text], [ 10 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 11-13
+$text = $stdtext1;
+expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ],
+ [ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 14-16
+$text = $stdtext1;
+expect [ extract_multiple($text,undef,3) ],
+ [ divide($stdtext1 => 4, 10, 26) ];
+
+expect [ pos $text], [ 26 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 17-19
+$text = $stdtext1;
+expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ],
+ [ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 20-22
+$text = $stdtext1;
+expect [ extract_multiple($text,undef,4) ],
+ [ divide($stdtext1 => 4, 10, 26, 27) ];
+
+expect [ pos $text], [ 27 ];
+expect [ $text ], [ $stdtext1 ];
+
+# TESTS 23-25
+$text = $stdtext1;
+expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ],
+ [ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+# TESTS 26-28
+$text = $stdtext1;
+expect [ extract_multiple($text,undef,5) ],
+ [ divide($stdtext1 => 4, 10, 26, 27) ];
+
+expect [ pos $text], [ 27 ];
+expect [ $text ], [ $stdtext1 ];
+
+
+# TESTS 29-31
+$text = $stdtext1;
+expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ],
+ [ substr($stdtext1,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext1,4) ];
+
+
+
+# TESTS 32-34
+$stdtext2 = q{$var = "val" && (1,2,3);};
+
+$text = $stdtext2;
+expect [ extract_multiple($text) ],
+ [ divide($stdtext2 => 4, 7, 12, 24) ];
+
+expect [ pos $text], [ 24 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 35-37
+$text = $stdtext2;
+expect [ scalar extract_multiple($text) ],
+ [ substr($stdtext2,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,4) ];
+
+
+# TESTS 38-40
+$text = $stdtext2;
+expect [ extract_multiple($text,[\&extract_bracketed]) ],
+ [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ];
+
+expect [ pos $text], [ 24 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 41-43
+$text = $stdtext2;
+expect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
+ [ substr($stdtext2,0,16) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,15) ];
+
+
+# TESTS 44-46
+$text = $stdtext2;
+expect [ extract_multiple($text,[\&extract_variable]) ],
+ [ substr($stdtext2,0,4), substr($stdtext2,4) ];
+
+expect [ pos $text], [ length($text) ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 47-49
+$text = $stdtext2;
+expect [ scalar extract_multiple($text,[\&extract_variable]) ],
+ [ substr($stdtext2,0,4) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,4) ];
+
+
+# TESTS 50-52
+$text = $stdtext2;
+expect [ extract_multiple($text,[\&extract_quotelike]) ],
+ [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ];
+
+expect [ pos $text], [ length($text) ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 53-55
+$text = $stdtext2;
+expect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
+ [ substr($stdtext2,0,7) ];
+
+expect [ pos $text], [ 0 ];
+expect [ $text ], [ substr($stdtext2,6) ];
+
+
+# TESTS 56-58
+$text = $stdtext2;
+expect [ extract_multiple($text,[\&extract_quotelike],2,1) ],
+ [ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 23 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 59-61
+$text = $stdtext2;
+expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ],
+ [ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 6 ];
+expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
+
+
+# TESTS 62-64
+$text = $stdtext2;
+expect [ extract_multiple($text,[\&extract_quotelike],1,1) ],
+ [ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 12 ];
+expect [ $text ], [ $stdtext2 ];
+
+# TESTS 65-67
+$text = $stdtext2;
+expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ],
+ [ substr($stdtext2,7,5) ];
+
+expect [ pos $text], [ 6 ];
+expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
+
+# TESTS 68-70
+my $stdtext3 = "a,b,c";
+
+$_ = $stdtext3;
+expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
+ [ divide($stdtext3 => 1,2,3,4,5) ];
+
+expect [ pos ], [ 5 ];
+expect [ $_ ], [ $stdtext3 ];
+
+# TESTS 71-73
+
+$_ = $stdtext3;
+expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
+ [ divide($stdtext3 => 1) ];
+
+expect [ pos ], [ 0 ];
+expect [ $_ ], [ substr($stdtext3,1) ];
+
+
+# TESTS 74-76
+
+$_ = $stdtext3;
+expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
+ [ divide($stdtext3 => 1,2,3,4,5) ];
+
+expect [ pos ], [ 5 ];
+expect [ $_ ], [ $stdtext3 ];
+
+# TESTS 77-79
+
+$_ = $stdtext3;
+expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
+ [ divide($stdtext3 => 1) ];
+
+expect [ pos ], [ 0 ];
+expect [ $_ ], [ substr($stdtext3,1) ];
+
+
+# TESTS 80-82
+
+$_ = $stdtext3;
+expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ],
+ [ qw(a b c) ];
+
+expect [ pos ], [ 5 ];
+expect [ $_ ], [ $stdtext3 ];
+
+# TESTS 83-85
+
+$_ = $stdtext3;
+expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
+ [ divide($stdtext3 => 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' ];
diff --git a/cpan/Text-Balanced/t/06_extqlk.t b/cpan/Text-Balanced/t/06_extqlk.t
new file mode 100644
index 0000000000..6badc0ee18
--- /dev/null
+++ b/cpan/Text-Balanced/t/06_extqlk.t
@@ -0,0 +1,135 @@
+#! /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'
+
+######################### We start with some black magic to print on failure.
+
+# 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"; }
+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 }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+ chomp $str;
+ 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';
+ $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";
+ }
+}
+
+# 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);
+'';
+"";
+"a";
+'b';
+`cc`;
+
+
+<<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;
+m/a/gci;
+
+q(d);
+qq(e);
+qx(f);
+qr(g);
+qw(h i j);
+q{d};
+qq{e};
+qx{f};
+qr{g};
+qq{a nested { and } are okay as are () and <> pairs and escaped \}'s };
+q/slash/;
+q # slash #;
+qr qw qx;
+
+s/x/y/;
+s/x/y/cgimsox;
+s{a}{b};
+s{a}\n {b};
+s(a){b};
+s(a)/b/;
+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 '->'
+<<EOHERE; done();\nline1\nline2\nEOHERE;\n; next; # RDEL HAS NO ';'
+<<'EOHERE'; done();\nline1\nline2\nEOHERE;\n; next; # RDEF HAS NO ';'
+ << EOTHERE; done();\nline1\nline2\n EOTHERE\n; next; # RDEL IS "" (!)
diff --git a/cpan/Text-Balanced/t/07_exttag.t b/cpan/Text-Balanced/t/07_exttag.t
new file mode 100644
index 0000000000..16a48b2ae3
--- /dev/null
+++ b/cpan/Text-Balanced/t/07_exttag.t
@@ -0,0 +1,113 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# 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..53\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_tagged gen_extract_tagged );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+ chomp $str;
+ 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 }
+ $str =~ s/\\n/\n/g;
+ debug "\tUsing: $cmd\n";
+ debug "\t on: [$str]\n";
+
+ my @res;
+ $var = eval "\@res = $cmd";
+ 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++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+
+ pos $str = 0;
+ $var = eval $cmd;
+ $var = "<undef>" unless defined $var;
+ debug "\t scalar got: [$var]\n";
+ debug "\t scalar left: [$str]\n";
+ print "not " if ($str =~ '\A;')==$neg;
+ print "ok ", $count++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+}
+
+__DATA__
+# USING: gen_extract_tagged("BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)")->($str);
+ ignore\n this and then BEGINHERE at the ENDHERE;
+ ignore\n this and then BEGINTHIS at the ENDTHIS;
+
+# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)");
+ ignore\n this and then BEGINHERE at the ENDHERE;
+ ignore\n this and then BEGINTHIS at the ENDTHIS;
+
+# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)");
+ ignore\n this and then BEGINHERE at the ENDHERE;
+ ignore\n this and then BEGINTHIS at the ENDTHIS;
+
+# THIS SHOULD FAIL
+ ignore\n this and then BEGINTHIS at the ENDTHAT;
+
+# USING: extract_tagged($str,"BEGIN","END","(?s).*?(?=BEGIN)");
+ ignore\n this and then BEGIN at the END;
+
+# USING: extract_tagged($str);
+ <A-1 HREF="#section2">some text</A-1>;
+
+# USING: extract_tagged($str,qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]});
+ <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# USING: extract_tagged($str,"BEGIN","END");
+ BEGIN at the BEGIN keyword and END at the END;
+ BEGIN at the beginning and end at the END;
+
+# USING: extract_tagged($str,undef,undef,undef,{ignore=>["<[^>]*/>"]});
+ <A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
+
+# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"MAX"});
+ ; at the ;-) keyword
+
+# USING: extract_tagged($str,"<[A-Z]+>",undef, undef, {ignore=>["<BR>"]});
+ <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# THESE SHOULD FAIL
+ BEGIN at the beginning and end at the end;
+ BEGIN at the BEGIN keyword and END at the end;
+
+# TEST EXTRACTION OF TAGGED STRINGS
+# USING: extract_tagged($str,"BEGIN","END",undef,{reject=>["BEGIN","END"]});
+# THESE SHOULD FAIL
+ BEGIN at the BEGIN keyword and END at the end;
+
+# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"PARA"});
+ ; at the ;-) keyword
+
+
+# USING: extract_tagged($str);
+ <A>some text</A>;
+ <B>some text<A>other text</A></B>;
+ <A>some text<A>other text</A></A>;
+ <A HREF="#section2">some text</A>;
+
+# THESE SHOULD FAIL
+ <A>some text
+ <A>some text<A>other text</A>;
+ <B>some text<A>other text</B>;
diff --git a/cpan/Text-Balanced/t/08_extvar.t b/cpan/Text-Balanced/t/08_extvar.t
new file mode 100644
index 0000000000..a33ac919ec
--- /dev/null
+++ b/cpan/Text-Balanced/t/08_extvar.t
@@ -0,0 +1,153 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# 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..183\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( extract_variable );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+ chomp $str;
+ 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 }
+ $str =~ s/\\n/\n/g;
+ debug "\tUsing: $cmd\n";
+ debug "\t on: [$str]\n";
+
+ my @res;
+ $var = eval "\@res = $cmd";
+ 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++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+
+ pos $str = 0;
+ $var = eval $cmd;
+ $var = "<undef>" unless defined $var;
+ debug "\t scalar got: [$var]\n";
+ debug "\t scalar left: [$str]\n";
+ print "not " if ($str =~ '\A;')==$neg;
+ print "ok ", $count++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+}
+
+__DATA__
+
+# USING: extract_variable($str);
+# THESE SHOULD FAIL
+$a->;
+$a (1..3) { print $a };
+
+# USING: extract_variable($str);
+$::obj;
+$obj->nextval;
+*var;
+*$var;
+*{var};
+*{$var};
+*var{cat};
+\&var;
+\&mod::var;
+\&mod'var;
+$a;
+$_;
+$a[1];
+$_[1];
+$a{cat};
+$_{cat};
+$a->[1];
+$a->{"cat"}[1];
+@$listref;
+@{$listref};
+$obj->nextval;
+$obj->_nextval;
+$obj->next_val_;
+@{$obj->nextval};
+@{$obj->nextval($cat,$dog)->{new}};
+@{$obj->nextval($cat?$dog:$fish)->{new}};
+@{$obj->nextval(cat()?$dog:$fish)->{new}};
+$ a {'cat'};
+$a::b::c{d}->{$e->()};
+$a'b'c'd{e}->{$e->()};
+$a'b::c'd{e}->{$e->()};
+$#_;
+$#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->;
+@{$;
+$ a :: b :: c
+$ a ' b ' c
+
+# USING: extract_variable($str,'=*');
+========$a;
diff --git a/cpan/Text-Balanced/t/09_gentag.t b/cpan/Text-Balanced/t/09_gentag.t
new file mode 100644
index 0000000000..0dd55a5f3f
--- /dev/null
+++ b/cpan/Text-Balanced/t/09_gentag.t
@@ -0,0 +1,102 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# 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..37\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Text::Balanced qw ( gen_extract_tagged );
+$loaded = 1;
+print "ok 1\n";
+$count=2;
+use vars qw( $DEBUG );
+sub debug { print "\t>>>",@_ if $DEBUG }
+
+######################### End of black magic.
+
+
+$cmd = "print";
+$neg = 0;
+while (defined($str = <DATA>))
+{
+ chomp $str;
+ $str =~ s/\\n/\n/g;
+ if ($str =~ s/\A# USING://)
+ {
+ $neg = 0;
+ eval{local$^W;*f = eval $str || die};
+ next;
+ }
+ elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
+ elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
+ $str =~ s/\\n/\n/g;
+ debug "\tUsing: $cmd\n";
+ debug "\t on: [$str]\n";
+
+ my @res;
+ $var = eval { @res = f($str) };
+ 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++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+
+ pos $str = 0;
+ $var = eval { scalar f($str) };
+ $var = "<undef>" unless defined $var;
+ debug "\t scalar got: [$var]\n";
+ debug "\t scalar left: [$str]\n";
+ print "not " if ($str =~ '\A;')==$neg;
+ print "ok ", $count++;
+ print " ($@)" if $@ && $DEBUG;
+ print "\n";
+}
+
+__DATA__
+
+# USING: gen_extract_tagged('{','}');
+ { a test };
+
+# USING: gen_extract_tagged(qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]});
+ <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# USING: gen_extract_tagged("BEGIN","END");
+ BEGIN at the BEGIN keyword and END at the END;
+ BEGIN at the beginning and end at the END;
+
+# USING: gen_extract_tagged(undef,undef,undef,{ignore=>["<[^>]*/>"]});
+ <A>aaa<B>bbb<BR/>ccc</B>ddd</A>;
+
+# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"MAX"});
+ ; at the ;-) keyword
+
+# USING: gen_extract_tagged("<[A-Z]+>",undef, undef, {ignore=>["<BR>"]});
+ <A>aaa<B>bbb<BR>ccc</B>ddd</A>;
+
+# THESE SHOULD FAIL
+ BEGIN at the beginning and end at the end;
+ BEGIN at the BEGIN keyword and END at the end;
+
+# TEST EXTRACTION OF TAGGED STRINGS
+# USING: gen_extract_tagged("BEGIN","END",undef,{reject=>["BEGIN","END"]});
+# THESE SHOULD FAIL
+ BEGIN at the BEGIN keyword and END at the end;
+
+# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"PARA"});
+ ; at the ;-) keyword
+
+
+# USING: gen_extract_tagged();
+ <A>some text</A>;
+ <B>some text<A>other text</A></B>;
+ <A>some text<A>other text</A></A>;
+ <A HREF="#section2">some text</A>;
+
+# THESE SHOULD FAIL
+ <A>some text
+ <A>some text<A>other text</A>;
+ <B>some text<A>other text</B>;