1 files changed, 319 insertions, 0 deletions
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' ];