1N/ABEGIN {
1N/A if ($ENV{PERL_CORE}) {
1N/A chdir('t') if -d 't';
1N/A @INC = qw(../lib);
1N/A }
1N/A}
1N/A
1N/A# Before `make install' is performed this script should be runnable with
1N/A# `make test'. After `make install' it should work as `perl test.pl'
1N/A
1N/A######################### We start with some black magic to print on failure.
1N/A
1N/A# Change 1..1 below to 1..last_test_to_print .
1N/A# (It may become useful if the test is moved to ./t subdirectory.)
1N/A
1N/ABEGIN { $| = 1; print "1..85\n"; }
1N/AEND {print "not ok 1\n" unless $loaded;}
1N/Ause Text::Balanced qw ( :ALL );
1N/A$loaded = 1;
1N/Aprint "ok 1\n";
1N/A$count=2;
1N/Ause vars qw( $DEBUG );
1N/Asub debug { print "\t>>>",@_ if $DEBUG }
1N/A
1N/A######################### End of black magic.
1N/A
1N/Asub expect
1N/A{
1N/A local $^W;
1N/A my ($l1, $l2) = @_;
1N/A
1N/A if (@$l1 != @$l2)
1N/A {
1N/A print "\@l1: ", join(", ", @$l1), "\n";
1N/A print "\@l2: ", join(", ", @$l2), "\n";
1N/A print "not ";
1N/A }
1N/A else
1N/A {
1N/A for (my $i = 0; $i < @$l1; $i++)
1N/A {
1N/A if ($l1->[$i] ne $l2->[$i])
1N/A {
1N/A print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n";
1N/A print "not ";
1N/A last;
1N/A }
1N/A }
1N/A }
1N/A
1N/A print "ok $count\n";
1N/A $count++;
1N/A}
1N/A
1N/Asub divide
1N/A{
1N/A my ($text, @index) = @_;
1N/A my @bits = ();
1N/A unshift @index, 0;
1N/A push @index, length($text);
1N/A for ( my $i= 0; $i < $#index; $i++)
1N/A {
1N/A push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]);
1N/A }
1N/A pop @bits;
1N/A return @bits;
1N/A
1N/A}
1N/A
1N/A
1N/A$stdtext1 = q{$var = do {"val" && $val;};};
1N/A
1N/A# TESTS 2-4
1N/A$text = $stdtext1;
1N/Aexpect [ extract_multiple($text,undef,1) ],
1N/A [ divide $stdtext1 => 4 ];
1N/A
1N/Aexpect [ pos $text], [ 4 ];
1N/Aexpect [ $text ], [ $stdtext1 ];
1N/A
1N/A# TESTS 5-7
1N/A$text = $stdtext1;
1N/Aexpect [ scalar extract_multiple($text,undef,1) ],
1N/A [ divide $stdtext1 => 4 ];
1N/A
1N/Aexpect [ pos $text], [ 0 ];
1N/Aexpect [ $text ], [ substr($stdtext1,4) ];
1N/A
1N/A
1N/A# TESTS 8-10
1N/A$text = $stdtext1;
1N/Aexpect [ extract_multiple($text,undef,2) ],
1N/A [ divide($stdtext1 => 4, 10) ];
1N/A
1N/Aexpect [ pos $text], [ 10 ];
1N/Aexpect [ $text ], [ $stdtext1 ];
1N/A
1N/A# TESTS 11-13
1N/A$text = $stdtext1;
1N/Aexpect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ],
1N/A [ substr($stdtext1,0,4) ];
1N/A
1N/Aexpect [ pos $text], [ 0 ];
1N/Aexpect [ $text ], [ substr($stdtext1,4) ];
1N/A
1N/A
1N/A# TESTS 14-16
1N/A$text = $stdtext1;
1N/Aexpect [ extract_multiple($text,undef,3) ],
1N/A [ divide($stdtext1 => 4, 10, 26) ];
1N/A
1N/Aexpect [ pos $text], [ 26 ];
1N/Aexpect [ $text ], [ $stdtext1 ];
1N/A
1N/A# TESTS 17-19
1N/A$text = $stdtext1;
1N/Aexpect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ],
1N/A [ substr($stdtext1,0,4) ];
1N/A
1N/Aexpect [ pos $text], [ 0 ];
1N/Aexpect [ $text ], [ substr($stdtext1,4) ];
1N/A
1N/A
1N/A# TESTS 20-22
1N/A$text = $stdtext1;
1N/Aexpect [ extract_multiple($text,undef,4) ],
1N/A [ divide($stdtext1 => 4, 10, 26, 27) ];
1N/A
1N/Aexpect [ pos $text], [ 27 ];
1N/Aexpect [ $text ], [ $stdtext1 ];
1N/A
1N/A# TESTS 23-25
1N/A$text = $stdtext1;
1N/Aexpect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ],
1N/A [ substr($stdtext1,0,4) ];
1N/A
1N/Aexpect [ pos $text], [ 0 ];
1N/Aexpect [ $text ], [ substr($stdtext1,4) ];
1N/A
1N/A
1N/A# TESTS 26-28
1N/A$text = $stdtext1;
1N/Aexpect [ extract_multiple($text,undef,5) ],
1N/A [ divide($stdtext1 => 4, 10, 26, 27) ];
1N/A
1N/Aexpect [ pos $text], [ 27 ];
1N/Aexpect [ $text ], [ $stdtext1 ];
1N/A
1N/A
1N/A# TESTS 29-31
1N/A$text = $stdtext1;
1N/Aexpect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ],
1N/A [ substr($stdtext1,0,4) ];
1N/A
1N/Aexpect [ pos $text], [ 0 ];
1N/Aexpect [ $text ], [ substr($stdtext1,4) ];
1N/A
1N/A
1N/A
1N/A# TESTS 32-34
1N/A$stdtext2 = q{$var = "val" && (1,2,3);};
1N/A
1N/A$text = $stdtext2;
1N/Aexpect [ extract_multiple($text) ],
1N/A [ divide($stdtext2 => 4, 7, 12, 24) ];
1N/A
1N/Aexpect [ pos $text], [ 24 ];
1N/Aexpect [ $text ], [ $stdtext2 ];
1N/A
1N/A# TESTS 35-37
1N/A$text = $stdtext2;
1N/Aexpect [ scalar extract_multiple($text) ],
1N/A [ substr($stdtext2,0,4) ];
1N/A
1N/Aexpect [ pos $text], [ 0 ];
1N/Aexpect [ $text ], [ substr($stdtext2,4) ];
1N/A
1N/A
1N/A# TESTS 38-40
1N/A$text = $stdtext2;
1N/Aexpect [ extract_multiple($text,[\&extract_bracketed]) ],
1N/A [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ];
1N/A
1N/Aexpect [ pos $text], [ 24 ];
1N/Aexpect [ $text ], [ $stdtext2 ];
1N/A
1N/A# TESTS 41-43
1N/A$text = $stdtext2;
1N/Aexpect [ scalar extract_multiple($text,[\&extract_bracketed]) ],
1N/A [ substr($stdtext2,0,16) ];
1N/A
1N/Aexpect [ pos $text], [ 0 ];
1N/Aexpect [ $text ], [ substr($stdtext2,15) ];
1N/A
1N/A
1N/A# TESTS 44-46
1N/A$text = $stdtext2;
1N/Aexpect [ extract_multiple($text,[\&extract_variable]) ],
1N/A [ substr($stdtext2,0,4), substr($stdtext2,4) ];
1N/A
1N/Aexpect [ pos $text], [ length($text) ];
1N/Aexpect [ $text ], [ $stdtext2 ];
1N/A
1N/A# TESTS 47-49
1N/A$text = $stdtext2;
1N/Aexpect [ scalar extract_multiple($text,[\&extract_variable]) ],
1N/A [ substr($stdtext2,0,4) ];
1N/A
1N/Aexpect [ pos $text], [ 0 ];
1N/Aexpect [ $text ], [ substr($stdtext2,4) ];
1N/A
1N/A
1N/A# TESTS 50-52
1N/A$text = $stdtext2;
1N/Aexpect [ extract_multiple($text,[\&extract_quotelike]) ],
1N/A [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ];
1N/A
1N/Aexpect [ pos $text], [ length($text) ];
1N/Aexpect [ $text ], [ $stdtext2 ];
1N/A
1N/A# TESTS 53-55
1N/A$text = $stdtext2;
1N/Aexpect [ scalar extract_multiple($text,[\&extract_quotelike]) ],
1N/A [ substr($stdtext2,0,7) ];
1N/A
1N/Aexpect [ pos $text], [ 0 ];
1N/Aexpect [ $text ], [ substr($stdtext2,6) ];
1N/A
1N/A
1N/A# TESTS 56-58
1N/A$text = $stdtext2;
1N/Aexpect [ extract_multiple($text,[\&extract_quotelike],2,1) ],
1N/A [ substr($stdtext2,7,5) ];
1N/A
1N/Aexpect [ pos $text], [ 23 ];
1N/Aexpect [ $text ], [ $stdtext2 ];
1N/A
1N/A# TESTS 59-61
1N/A$text = $stdtext2;
1N/Aexpect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ],
1N/A [ substr($stdtext2,7,5) ];
1N/A
1N/Aexpect [ pos $text], [ 6 ];
1N/Aexpect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
1N/A
1N/A
1N/A# TESTS 62-64
1N/A$text = $stdtext2;
1N/Aexpect [ extract_multiple($text,[\&extract_quotelike],1,1) ],
1N/A [ substr($stdtext2,7,5) ];
1N/A
1N/Aexpect [ pos $text], [ 12 ];
1N/Aexpect [ $text ], [ $stdtext2 ];
1N/A
1N/A# TESTS 65-67
1N/A$text = $stdtext2;
1N/Aexpect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ],
1N/A [ substr($stdtext2,7,5) ];
1N/A
1N/Aexpect [ pos $text], [ 6 ];
1N/Aexpect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ];
1N/A
1N/A# TESTS 68-70
1N/Amy $stdtext3 = "a,b,c";
1N/A
1N/A$_ = $stdtext3;
1N/Aexpect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
1N/A [ divide($stdtext3 => 1,2,3,4,5) ];
1N/A
1N/Aexpect [ pos ], [ 5 ];
1N/Aexpect [ $_ ], [ $stdtext3 ];
1N/A
1N/A# TESTS 71-73
1N/A
1N/A$_ = $stdtext3;
1N/Aexpect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ],
1N/A [ divide($stdtext3 => 1) ];
1N/A
1N/Aexpect [ pos ], [ 0 ];
1N/Aexpect [ $_ ], [ substr($stdtext3,1) ];
1N/A
1N/A
1N/A# TESTS 74-76
1N/A
1N/A$_ = $stdtext3;
1N/Aexpect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
1N/A [ divide($stdtext3 => 1,2,3,4,5) ];
1N/A
1N/Aexpect [ pos ], [ 5 ];
1N/Aexpect [ $_ ], [ $stdtext3 ];
1N/A
1N/A# TESTS 77-79
1N/A
1N/A$_ = $stdtext3;
1N/Aexpect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ],
1N/A [ divide($stdtext3 => 1) ];
1N/A
1N/Aexpect [ pos ], [ 0 ];
1N/Aexpect [ $_ ], [ substr($stdtext3,1) ];
1N/A
1N/A
1N/A# TESTS 80-82
1N/A
1N/A$_ = $stdtext3;
1N/Aexpect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ],
1N/A [ qw(a b c) ];
1N/A
1N/Aexpect [ pos ], [ 5 ];
1N/Aexpect [ $_ ], [ $stdtext3 ];
1N/A
1N/A# TESTS 83-85
1N/A
1N/A$_ = $stdtext3;
1N/Aexpect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ],
1N/A [ divide($stdtext3 => 1) ];
1N/A
1N/Aexpect [ pos ], [ 0 ];
1N/Aexpect [ $_ ], [ substr($stdtext3,2) ];