[p5sagit/p5-mst-13.2.git] / cpan / Text-Balanced / t / 05_extmul.t

# 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' ];
Commit	Line	Data
3270c621	1	# Before `make install' is performed this script should be runnable with
	2	# `make test'. After `make install' it should work as `perl test.pl'
	3
	4	######################### We start with some black magic to print on failure.
	5
	6	# Change 1..1 below to 1..last_test_to_print .
	7	# (It may become useful if the test is moved to ./t subdirectory.)
	8
aa10195b	9	BEGIN { $\| = 1; print "1..86\n"; }
3270c621	10	END {print "not ok 1\n" unless $loaded;}
	11	use Text::Balanced qw ( :ALL );
	12	$loaded = 1;
	13	print "ok 1\n";
	14	$count=2;
	15	use vars qw( $DEBUG );
	16	sub debug { print "\t>>>",@_ if $DEBUG }
	17
	18	######################### End of black magic.
	19
	20	sub expect
	21	{
	22	local $^W;
	23	my ($l1, $l2) = @_;
	24
	25	if (@$l1 != @$l2)
	26	{
	27	print "\@l1: ", join(", ", @$l1), "\n";
	28	print "\@l2: ", join(", ", @$l2), "\n";
	29	print "not ";
	30	}
	31	else
	32	{
	33	for (my $i = 0; $i < @$l1; $i++)
	34	{
	35	if ($l1->[$i] ne $l2->[$i])
	36	{
	37	print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n";
	38	print "not ";
	39	last;
	40	}
	41	}
	42	}
	43
	44	print "ok $count\n";
	45	$count++;
	46	}
	47
	48	sub divide
	49	{
	50	my ($text, @index) = @_;
	51	my @bits = ();
	52	unshift @index, 0;
	53	push @index, length($text);
	54	for ( my $i= 0; $i < $#index; $i++)
	55	{
	56	push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]);
	57	}
	58	pop @bits;
	59	return @bits;
	60
	61	}
	62
	63
	64	$stdtext1 = q{$var = do {"val" && $val;};};
	65
	66	# TESTS 2-4
	67	$text = $stdtext1;
	68	expect [ extract_multiple($text,undef,1) ],
	69	[ divide $stdtext1 => 4 ];
	70
	71	expect [ pos $text], [ 4 ];
	72	expect [ $text ], [ $stdtext1 ];
	73
74	# TESTS 5-7
75	$text = $stdtext1;
76	expect [ scalar extract_multiple($text,undef,1) ],
77	[ divide $stdtext1 => 4 ];
78
79	expect [ pos $text], [ 0 ];
80	expect [ $text ], [ substr($stdtext1,4) ];
81
82
83	# TESTS 8-10
84	$text = $stdtext1;
85	expect [ extract_multiple($text,undef,2) ],
86	[ divide($stdtext1 => 4, 10) ];
87
88	expect [ pos $text], [ 10 ];
89	expect [ $text ], [ $stdtext1 ];
90
91	# TESTS 11-13
92	$text = $stdtext1;
93	expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ],
94	[ substr($stdtext1,0,4) ];
95
96	expect [ pos $text], [ 0 ];
97	expect [ $text ], [ substr($stdtext1,4) ];
98
99
100	# TESTS 14-16
101	$text = $stdtext1;
102	expect [ extract_multiple($text,undef,3) ],
103	[ divide($stdtext1 => 4, 10, 26) ];
104
105	expect [ pos $text], [ 26 ];
106	expect [ $text ], [ $stdtext1 ];
107
108	# TESTS 17-19
109	$text = $stdtext1;
110	expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ],
111	[ substr($stdtext1,0,4) ];
112
113	expect [ pos $text], [ 0 ];
114	expect [ $text ], [ substr($stdtext1,4) ];
115
116
117	# TESTS 20-22
118	$text = $stdtext1;
119	expect [ extract_multiple($text,undef,4) ],
120	[ divide($stdtext1 => 4, 10, 26, 27) ];
121
122	expect [ pos $text], [ 27 ];
123	expect [ $text ], [ $stdtext1 ];
124
125	# TESTS 23-25
126	$text = $stdtext1;
127	expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ],
128	[ substr($stdtext1,0,4) ];
129
130	expect [ pos $text], [ 0 ];
131	expect [ $text ], [ substr($stdtext1,4) ];
132
133
134	# TESTS 26-28
135	$text = $stdtext1;
136	expect [ extract_multiple($text,undef,5) ],
137	[ divide($stdtext1 => 4, 10, 26, 27) ];
138
139	expect [ pos $text], [ 27 ];
140	expect [ $text ], [ $stdtext1 ];
141
142
143	# TESTS 29-31
144	$text = $stdtext1;
145	expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ],
146	[ substr($stdtext1,0,4) ];
147
148	expect [ pos $text], [ 0 ];
149	expect [ $text ], [ substr($stdtext1,4) ];
150
151
152
153	# TESTS 32-34
154	$stdtext2 = q{$var = "val" && (1,2,3);};
155
156	$text = $stdtext2;
157	expect [ extract_multiple($text) ],
158	[ divide($stdtext2 => 4, 7, 12, 24) ];
159
160	expect [ pos $text], [ 24 ];
161	expect [ $text ], [ $stdtext2 ];
162
163	# TESTS 35-37
164	$text = $stdtext2;
165	expect [ scalar extract_multiple($text) ],
166	[ substr($stdtext2,0,4) ];
167
168	expect [ pos $text], [ 0 ];
169	expect [ $text ], [ substr($stdtext2,4) ];
170
171
172	# TESTS 38-40
173	$text = $stdtext2;
174	expect [ extract_multiple($text,[\&extract_bracketed]) ],
a7602084	175	[ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ];
3270c621	176
	177	expect [ pos $text], [ 24 ];
	178	expect [ $text ], [ $stdtext2 ];
	179
	180	# TESTS 41-43
	181	$text = $stdtext2;
	182	expect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
a7602084	183	[ substr($stdtext2,0,16) ];
3270c621	184
	185	expect [ pos $text], [ 0 ];
	186	expect [ $text ], [ substr($stdtext2,15) ];
	187
	188
	189	# TESTS 44-46
	190	$text = $stdtext2;
	191	expect [ extract_multiple($text,[\&extract_variable]) ],
	192	[ substr($stdtext2,0,4), substr($stdtext2,4) ];
	193
	194	expect [ pos $text], [ length($text) ];
	195	expect [ $text ], [ $stdtext2 ];
	196
	197	# TESTS 47-49
	198	$text = $stdtext2;
	199	expect [ scalar extract_multiple($text,[\&extract_variable]) ],
	200	[ substr($stdtext2,0,4) ];
	201
	202	expect [ pos $text], [ 0 ];
	203	expect [ $text ], [ substr($stdtext2,4) ];
	204
	205
	206	# TESTS 50-52
	207	$text = $stdtext2;
	208	expect [ extract_multiple($text,[\&extract_quotelike]) ],
a7602084	209	[ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ];
3270c621	210
	211	expect [ pos $text], [ length($text) ];
	212	expect [ $text ], [ $stdtext2 ];
	213
	214	# TESTS 53-55
	215	$text = $stdtext2;
	216	expect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
a7602084	217	[ substr($stdtext2,0,7) ];
3270c621	218
	219	expect [ pos $text], [ 0 ];
	220	expect [ $text ], [ substr($stdtext2,6) ];
	221
	222
	223	# TESTS 56-58
	224	$text = $stdtext2;
	225	expect [ extract_multiple($text,[\&extract_quotelike],2,1) ],
	226	[ substr($stdtext2,7,5) ];
	227
	228	expect [ pos $text], [ 23 ];
	229	expect [ $text ], [ $stdtext2 ];
	230
	231	# TESTS 59-61
	232	$text = $stdtext2;
	233	expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ],
	234	[ substr($stdtext2,7,5) ];
	235
	236	expect [ pos $text], [ 6 ];
	237	expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
	238
	239
	240	# TESTS 62-64
	241	$text = $stdtext2;
	242	expect [ extract_multiple($text,[\&extract_quotelike],1,1) ],
	243	[ substr($stdtext2,7,5) ];
	244
	245	expect [ pos $text], [ 12 ];
	246	expect [ $text ], [ $stdtext2 ];
	247
	248	# TESTS 65-67
	249	$text = $stdtext2;
	250	expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ],
	251	[ substr($stdtext2,7,5) ];
	252
	253	expect [ pos $text], [ 6 ];
	254	expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
	255
	256	# TESTS 68-70
	257	my $stdtext3 = "a,b,c";
	258
	259	$_ = $stdtext3;
	260	expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
	261	[ divide($stdtext3 => 1,2,3,4,5) ];
	262
	263	expect [ pos ], [ 5 ];
	264	expect [ $_ ], [ $stdtext3 ];
	265
	266	# TESTS 71-73
	267
	268	$_ = $stdtext3;
	269	expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
	270	[ divide($stdtext3 => 1) ];
	271
	272	expect [ pos ], [ 0 ];
	273	expect [ $_ ], [ substr($stdtext3,1) ];
	274
	275
	276	# TESTS 74-76
	277
	278	$_ = $stdtext3;
	279	expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
	280	[ divide($stdtext3 => 1,2,3,4,5) ];
	281
282	expect [ pos ], [ 5 ];
283	expect [ $_ ], [ $stdtext3 ];
284
285	# TESTS 77-79
286
287	$_ = $stdtext3;
288	expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
289	[ divide($stdtext3 => 1) ];
290
291	expect [ pos ], [ 0 ];
292	expect [ $_ ], [ substr($stdtext3,1) ];
293
294
295	# TESTS 80-82
296
297	$_ = $stdtext3;
298	expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ],
299	[ qw(a b c) ];
300
301	expect [ pos ], [ 5 ];
302	expect [ $_ ], [ $stdtext3 ];
303
304	# TESTS 83-85
305
306	$_ = $stdtext3;
307	expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
308	[ divide($stdtext3 => 1) ];
309
310	expect [ pos ], [ 0 ];
311	expect [ $_ ], [ substr($stdtext3,2) ];
aa10195b	312
	313
	314	# TEST 86
	315
	316	# Fails in Text-Balanced-1.95 with result ['1 ', '""', '1234']
	317	$_ = q{ ""1234};
	318	expect [ extract_multiple(undef, [\&extract_quotelike]) ],
	319	[ ' ', '""', '1234' ];