diff options
Diffstat (limited to 'cpan/Text-Balanced/t')
-rw-r--r-- | cpan/Text-Balanced/t/01_compile.t | 11 | ||||
-rw-r--r-- | cpan/Text-Balanced/t/02_extbrk.t | 76 | ||||
-rw-r--r-- | cpan/Text-Balanced/t/03_extcbk.t | 95 | ||||
-rw-r--r-- | cpan/Text-Balanced/t/04_extdel.t | 90 | ||||
-rw-r--r-- | cpan/Text-Balanced/t/05_extmul.t | 319 | ||||
-rw-r--r-- | cpan/Text-Balanced/t/06_extqlk.t | 135 | ||||
-rw-r--r-- | cpan/Text-Balanced/t/07_exttag.t | 113 | ||||
-rw-r--r-- | cpan/Text-Balanced/t/08_extvar.t | 153 | ||||
-rw-r--r-- | cpan/Text-Balanced/t/09_gentag.t | 102 |
9 files changed, 1094 insertions, 0 deletions
diff --git a/cpan/Text-Balanced/t/01_compile.t b/cpan/Text-Balanced/t/01_compile.t new file mode 100644 index 0000000000..77c1099995 --- /dev/null +++ b/cpan/Text-Balanced/t/01_compile.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +BEGIN { + $| = 1; + $^W = 1; +} + +use Test::More tests => 1; + +use_ok( 'Text::Balanced' ); diff --git a/cpan/Text-Balanced/t/02_extbrk.t b/cpan/Text-Balanced/t/02_extbrk.t new file mode 100644 index 0000000000..a36025ddb0 --- /dev/null +++ b/cpan/Text-Balanced/t/02_extbrk.t @@ -0,0 +1,76 @@ +# 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..19\n"; } +END {print "not ok 1\n" unless $loaded;} +use Text::Balanced qw ( extract_bracketed ); +$loaded = 1; +print "ok 1\n"; +$count=2; +use vars qw( $DEBUG ); +sub debug { print "\t>>>",@_ if $DEBUG } + +######################### End of black magic. + + +$cmd = "print"; +$neg = 0; +while (defined($str = <DATA>)) +{ + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; + + $var = eval "() = $cmd"; + debug "\t list got: [$var]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str),1) eq ';')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; + + pos $str = 0; + $var = eval $cmd; + $var = "<undef>" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; +} + +__DATA__ + +# USING: extract_bracketed($str); +{a nested { and } are okay as are () and <> pairs and escaped \}'s }; +{a nested\n{ and } are okay as are\n() and <> pairs and escaped \}'s }; + +# USING: extract_bracketed($str,'{}'); +{a nested { and } are okay as are unbalanced ( and < pairs and escaped \}'s }; + +# THESE SHOULD FAIL +{an unmatched nested { isn't okay, nor are ( and < }; +{an unbalanced nested [ even with } and ] to match them; + + +# USING: extract_bracketed($str,'<"`q>'); +<a q{uoted} ">" unbalanced right bracket of /(q>)/ either sort (`>>>""">>>>`) is okay >; + +# USING: extract_bracketed($str,'<">'); +<a quoted ">" unbalanced right bracket is okay >; + +# USING: extract_bracketed($str,'<"`>'); +<a quoted ">" unbalanced right bracket of either sort (`>>>""">>>>`) is okay >; + +# THIS SHOULD FAIL +<a misquoted '>' unbalanced right bracket is bad >; diff --git a/cpan/Text-Balanced/t/03_extcbk.t b/cpan/Text-Balanced/t/03_extcbk.t new file mode 100644 index 0000000000..83081ae28d --- /dev/null +++ b/cpan/Text-Balanced/t/03_extcbk.t @@ -0,0 +1,95 @@ +# 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..41\n"; } +END {print "not ok 1\n" unless $loaded;} +use Text::Balanced qw ( extract_codeblock ); +$loaded = 1; +print "ok 1\n"; +$count=2; +use vars qw( $DEBUG ); +sub debug { print "\t>>>",@_ if $DEBUG } + +######################### End of black magic. + + +$cmd = "print"; +$neg = 0; +while (defined($str = <DATA>)) +{ + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; + + my @res; + $var = eval "\@res = $cmd"; + debug "\t Failed: $@ at " . $@+0 .")" if $@; + debug "\t list got: [" . join("|", map {defined $_ ? $_ : '<undef>'} @res) . "]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; + print "ok ", $count++; + print "\n"; + + pos $str = 0; + $var = eval $cmd; + $var = "<undef>" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; +} + +__DATA__ + +# USING: extract_codeblock($str,'(){}',undef,'()'); +(Foo(')')); + +# USING: extract_codeblock($str); +{ $data[4] =~ /['"]/; }; + +# USING: extract_codeblock($str,'<>'); +< %x = ( try => "this") >; +< %x = () >; +< %x = ( $try->{this}, "too") >; +< %'x = ( $try->{this}, "too") >; +< %'x'y = ( $try->{this}, "too") >; +< %::x::y = ( $try->{this}, "too") >; + +# THIS SHOULD FAIL +< %x = do { $try > 10 } >; + +# USING: extract_codeblock($str); + +{ $a = /\}/; }; +{ sub { $_[0] /= $_[1] } }; # / here +{ 1; }; +{ $a = 1; }; + + +# USING: extract_codeblock($str,undef,'=*'); +========{$a=1}; + +# USING: extract_codeblock($str,'{}<>'); +< %x = do { $try > 10 } >; + +# USING: extract_codeblock($str,'{}',undef,'<>'); +< %x = do { $try > 10 } >; + +# USING: extract_codeblock($str,'{}'); +{ $a = $b; # what's this doing here? \n };' +{ $a = $b; \n $a =~ /$b/; \n @a = map /\s/ @b }; + +# THIS SHOULD FAIL +{ $a = $b; # what's this doing here? };' +{ $a = $b; # what's this doing here? ;' diff --git a/cpan/Text-Balanced/t/04_extdel.t b/cpan/Text-Balanced/t/04_extdel.t new file mode 100644 index 0000000000..c5ca88eebf --- /dev/null +++ b/cpan/Text-Balanced/t/04_extdel.t @@ -0,0 +1,90 @@ +# 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..45\n"; } +END {print "not ok 1\n" unless $loaded;} +use Text::Balanced qw ( extract_delimited ); +$loaded = 1; +print "ok 1\n"; +$count=2; +use vars qw( $DEBUG ); +sub debug { print "\t>>>",@_ if $DEBUG } + +######################### End of black magic. + + +$cmd = "print"; +$neg = 0; +while (defined($str = <DATA>)) +{ + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; + + $var = eval "() = $cmd"; + debug "\t list got: [$var]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; + + pos $str = 0; + $var = eval $cmd; + $var = "<undef>" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; +} + +__DATA__ +# USING: extract_delimited($str,'/#$',undef,'/#$'); +/a/; +/a///; +#b#; +#b###; +$c$; +$c$$$; + +# TEST EXTRACTION OF DELIMITED TEXT WITH ESCAPES +# USING: extract_delimited($str,'/#$',undef,'\\'); +/a/; +/a\//; +#b#; +#b\##; +$c$; +$c\$$; + +# TEST EXTRACTION OF DELIMITED TEXT +# USING: extract_delimited($str); +'a'; +"b"; +`c`; +'a\''; +'a\\'; +'\\a'; +"a\\"; +"\\a"; +"b\'\"\'"; +`c '\`abc\`'`; + +# TEST EXTRACTION OF DELIMITED TEXT +# USING: extract_delimited($str,'/#$','-->'); +-->/a/; +-->#b#; +-->$c$; + +# THIS SHOULD FAIL +$c$; 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' ]; diff --git a/cpan/Text-Balanced/t/06_extqlk.t b/cpan/Text-Balanced/t/06_extqlk.t new file mode 100644 index 0000000000..6badc0ee18 --- /dev/null +++ b/cpan/Text-Balanced/t/06_extqlk.t @@ -0,0 +1,135 @@ +#! /usr/local/bin/perl -ws +# 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..95\n"; } +END {print "not ok 1\n" unless $loaded;} +use Text::Balanced qw ( extract_quotelike ); +$loaded = 1; +print "ok 1\n"; +$count=2; +use vars qw( $DEBUG ); +#$DEBUG=1; +sub debug { print "\t>>>",@_ if $ENV{DEBUG} } +sub esc { my $x = shift||'<undef>'; $x =~ s/\n/\\n/gs; $x } + +######################### End of black magic. + + +$cmd = "print"; +$neg = 0; +while (defined($str = <DATA>)) +{ + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + my $setup_cmd = ($str =~ s/\A\{(.*)\}//) ? $1 : ''; + my $tests = 'sl'; + $str =~ s/\\n/\n/g; + my $orig = $str; + + eval $setup_cmd if $setup_cmd ne ''; + if($tests =~ /l/) { + debug "\tUsing: $cmd\n"; + debug "\t on: [" . esc($setup_cmd) . "][" . esc($str) . "]\n"; + my @res; + eval qq{\@res = $cmd; }; + debug "\t got:\n" . join "", map { "\t\t\t$_: [" . esc($res[$_]) . "]\n"} (0..$#res); + debug "\t left: [" . esc($str) . "]\n"; + debug "\t pos: [" . esc(substr($str,pos($str))) . "...]\n"; + print "not " if (substr($str,pos($str),1) eq ';')==$neg; + print "ok ", $count++; + print "\n"; + } + + eval $setup_cmd if $setup_cmd ne ''; + if($tests =~ /s/) { + $str = $orig; + debug "\tUsing: scalar $cmd\n"; + debug "\t on: [" . esc($str) . "]\n"; + $var = eval $cmd; + print " ($@)" if $@ && $DEBUG; + $var = "<undef>" unless defined $var; + debug "\t scalar got: [" . esc($var) . "]\n"; + debug "\t scalar left: [" . esc($str) . "]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print "\n"; + } +} + +# fails in Text::Balanced 1.95 +$_ = qq(s{}{}); +my @z = extract_quotelike(); +print "not " if $z[0] eq ''; +print "ok ", $count++; +print "\n"; + + +__DATA__ + +# USING: extract_quotelike($str); +''; +""; +"a"; +'b'; +`cc`; + + +<<EOHERE; done();\nline1\nline2\nEOHERE\n; next; + <<EOHERE; done();\nline1\nline2\nEOHERE\n; next; +<<"EOHERE"; done()\nline1\nline2\nEOHERE\n and next +<<`EOHERE`; done()\nline1\nline2\nEOHERE\n and next +<<'EOHERE'; done()\nline1\n'line2'\nEOHERE\n and next +<<'EOHERE;'; done()\nline1\nline2\nEOHERE;\n and next +<<" EOHERE"; done() \nline1\nline2\n EOHERE\nand next +<<""; done()\nline1\nline2\n\n and next +<<; done()\nline1\nline2\n\n and next +# fails in Text::Balanced 1.95 +<<EOHERE;\nEOHERE\n; +# fails in Text::Balanced 1.95 +<<"*";\n\n*\n; + +"this is a nested $var[$x] {"; +/a/gci; +m/a/gci; + +q(d); +qq(e); +qx(f); +qr(g); +qw(h i j); +q{d}; +qq{e}; +qx{f}; +qr{g}; +qq{a nested { and } are okay as are () and <> pairs and escaped \}'s }; +q/slash/; +q # slash #; +qr qw qx; + +s/x/y/; +s/x/y/cgimsox; +s{a}{b}; +s{a}\n {b}; +s(a){b}; +s(a)/b/; +s/'/\\'/g; +tr/x/y/; +y/x/y/; + +# fails on Text-Balanced-1.95 +{ $tests = 'l'; pos($str)=6 }012345<<E;\n\nE\n + +# THESE SHOULD FAIL +s<$self->{pat}>{$self->{sub}}; # CAN'T HANDLE '>' in '->' +s-$self->{pap}-$self->{sub}-; # CAN'T HANDLE '-' in '->' +<<EOHERE; done();\nline1\nline2\nEOHERE;\n; next; # RDEL HAS NO ';' +<<'EOHERE'; done();\nline1\nline2\nEOHERE;\n; next; # RDEF HAS NO ';' + << EOTHERE; done();\nline1\nline2\n EOTHERE\n; next; # RDEL IS "" (!) diff --git a/cpan/Text-Balanced/t/07_exttag.t b/cpan/Text-Balanced/t/07_exttag.t new file mode 100644 index 0000000000..16a48b2ae3 --- /dev/null +++ b/cpan/Text-Balanced/t/07_exttag.t @@ -0,0 +1,113 @@ +# 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..53\n"; } +END {print "not ok 1\n" unless $loaded;} +use Text::Balanced qw ( extract_tagged gen_extract_tagged ); +$loaded = 1; +print "ok 1\n"; +$count=2; +use vars qw( $DEBUG ); +sub debug { print "\t>>>",@_ if $DEBUG } + +######################### End of black magic. + + +$cmd = "print"; +$neg = 0; +while (defined($str = <DATA>)) +{ + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; + + my @res; + $var = eval "\@res = $cmd"; + debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; + + pos $str = 0; + $var = eval $cmd; + $var = "<undef>" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; +} + +__DATA__ +# USING: gen_extract_tagged("BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)")->($str); + ignore\n this and then BEGINHERE at the ENDHERE; + ignore\n this and then BEGINTHIS at the ENDTHIS; + +# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)"); + ignore\n this and then BEGINHERE at the ENDHERE; + ignore\n this and then BEGINTHIS at the ENDTHIS; + +# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)"); + ignore\n this and then BEGINHERE at the ENDHERE; + ignore\n this and then BEGINTHIS at the ENDTHIS; + +# THIS SHOULD FAIL + ignore\n this and then BEGINTHIS at the ENDTHAT; + +# USING: extract_tagged($str,"BEGIN","END","(?s).*?(?=BEGIN)"); + ignore\n this and then BEGIN at the END; + +# USING: extract_tagged($str); + <A-1 HREF="#section2">some text</A-1>; + +# USING: extract_tagged($str,qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]}); + <A>aaa<B>bbb<BR>ccc</B>ddd</A>; + +# USING: extract_tagged($str,"BEGIN","END"); + BEGIN at the BEGIN keyword and END at the END; + BEGIN at the beginning and end at the END; + +# USING: extract_tagged($str,undef,undef,undef,{ignore=>["<[^>]*/>"]}); + <A>aaa<B>bbb<BR/>ccc</B>ddd</A>; + +# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"MAX"}); + ; at the ;-) keyword + +# USING: extract_tagged($str,"<[A-Z]+>",undef, undef, {ignore=>["<BR>"]}); + <A>aaa<B>bbb<BR>ccc</B>ddd</A>; + +# THESE SHOULD FAIL + BEGIN at the beginning and end at the end; + BEGIN at the BEGIN keyword and END at the end; + +# TEST EXTRACTION OF TAGGED STRINGS +# USING: extract_tagged($str,"BEGIN","END",undef,{reject=>["BEGIN","END"]}); +# THESE SHOULD FAIL + BEGIN at the BEGIN keyword and END at the end; + +# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"PARA"}); + ; at the ;-) keyword + + +# USING: extract_tagged($str); + <A>some text</A>; + <B>some text<A>other text</A></B>; + <A>some text<A>other text</A></A>; + <A HREF="#section2">some text</A>; + +# THESE SHOULD FAIL + <A>some text + <A>some text<A>other text</A>; + <B>some text<A>other text</B>; diff --git a/cpan/Text-Balanced/t/08_extvar.t b/cpan/Text-Balanced/t/08_extvar.t new file mode 100644 index 0000000000..a33ac919ec --- /dev/null +++ b/cpan/Text-Balanced/t/08_extvar.t @@ -0,0 +1,153 @@ +# 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..183\n"; } +END {print "not ok 1\n" unless $loaded;} +use Text::Balanced qw ( extract_variable ); +$loaded = 1; +print "ok 1\n"; +$count=2; +use vars qw( $DEBUG ); +sub debug { print "\t>>>",@_ if $DEBUG } + +######################### End of black magic. + + +$cmd = "print"; +$neg = 0; +while (defined($str = <DATA>)) +{ + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; + + my @res; + $var = eval "\@res = $cmd"; + debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; + + pos $str = 0; + $var = eval $cmd; + $var = "<undef>" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; +} + +__DATA__ + +# USING: extract_variable($str); +# THESE SHOULD FAIL +$a->; +$a (1..3) { print $a }; + +# USING: extract_variable($str); +$::obj; +$obj->nextval; +*var; +*$var; +*{var}; +*{$var}; +*var{cat}; +\&var; +\&mod::var; +\&mod'var; +$a; +$_; +$a[1]; +$_[1]; +$a{cat}; +$_{cat}; +$a->[1]; +$a->{"cat"}[1]; +@$listref; +@{$listref}; +$obj->nextval; +$obj->_nextval; +$obj->next_val_; +@{$obj->nextval}; +@{$obj->nextval($cat,$dog)->{new}}; +@{$obj->nextval($cat?$dog:$fish)->{new}}; +@{$obj->nextval(cat()?$dog:$fish)->{new}}; +$ a {'cat'}; +$a::b::c{d}->{$e->()}; +$a'b'c'd{e}->{$e->()}; +$a'b::c'd{e}->{$e->()}; +$#_; +$#array; +$#{array}; +$var[$#var]; +$1; +$11; +$&; +$`; +$'; +$+; +$*; +$.; +$/; +$|; +$,; +$"; +$;; +$#; +$%; +$=; +$-; +$~; +$^; +$:; +$^L; +$^A; +$?; +$!; +$^E; +$@; +$$; +$<; +$>; +$(; +$); +$[; +$]; +$^C; +$^D; +$^F; +$^H; +$^I; +$^M; +$^O; +$^P; +$^R; +$^S; +$^T; +$^V; +$^W; +${^WARNING_BITS}; +${^WIDE_SYSTEM_CALLS}; +$^X; + +# THESE SHOULD FAIL +$a->; +@{$; +$ a :: b :: c +$ a ' b ' c + +# USING: extract_variable($str,'=*'); +========$a; diff --git a/cpan/Text-Balanced/t/09_gentag.t b/cpan/Text-Balanced/t/09_gentag.t new file mode 100644 index 0000000000..0dd55a5f3f --- /dev/null +++ b/cpan/Text-Balanced/t/09_gentag.t @@ -0,0 +1,102 @@ +# 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..37\n"; } +END {print "not ok 1\n" unless $loaded;} +use Text::Balanced qw ( gen_extract_tagged ); +$loaded = 1; +print "ok 1\n"; +$count=2; +use vars qw( $DEBUG ); +sub debug { print "\t>>>",@_ if $DEBUG } + +######################### End of black magic. + + +$cmd = "print"; +$neg = 0; +while (defined($str = <DATA>)) +{ + chomp $str; + $str =~ s/\\n/\n/g; + if ($str =~ s/\A# USING://) + { + $neg = 0; + eval{local$^W;*f = eval $str || die}; + next; + } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; + + my @res; + $var = eval { @res = f($str) }; + debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; + + pos $str = 0; + $var = eval { scalar f($str) }; + $var = "<undef>" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; +} + +__DATA__ + +# USING: gen_extract_tagged('{','}'); + { a test }; + +# USING: gen_extract_tagged(qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]}); + <A>aaa<B>bbb<BR>ccc</B>ddd</A>; + +# USING: gen_extract_tagged("BEGIN","END"); + BEGIN at the BEGIN keyword and END at the END; + BEGIN at the beginning and end at the END; + +# USING: gen_extract_tagged(undef,undef,undef,{ignore=>["<[^>]*/>"]}); + <A>aaa<B>bbb<BR/>ccc</B>ddd</A>; + +# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"MAX"}); + ; at the ;-) keyword + +# USING: gen_extract_tagged("<[A-Z]+>",undef, undef, {ignore=>["<BR>"]}); + <A>aaa<B>bbb<BR>ccc</B>ddd</A>; + +# THESE SHOULD FAIL + BEGIN at the beginning and end at the end; + BEGIN at the BEGIN keyword and END at the end; + +# TEST EXTRACTION OF TAGGED STRINGS +# USING: gen_extract_tagged("BEGIN","END",undef,{reject=>["BEGIN","END"]}); +# THESE SHOULD FAIL + BEGIN at the BEGIN keyword and END at the end; + +# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"PARA"}); + ; at the ;-) keyword + + +# USING: gen_extract_tagged(); + <A>some text</A>; + <B>some text<A>other text</A></B>; + <A>some text<A>other text</A></A>; + <A HREF="#section2">some text</A>; + +# THESE SHOULD FAIL + <A>some text + <A>some text<A>other text</A>; + <B>some text<A>other text</B>; |