[perl5.git] / lib / Text / Balanced / t / extmul.t

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