[perl5.git] / t / lib / tb-xmult.t

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib';
}

# 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..85\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,15), 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,15) ];

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,6), 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,6) ];

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