1BEGIN { 2 if ($ENV{PERL_CORE}) { 3 chdir('t') if -d 't'; 4 @INC = qw(../lib); 5 } 6} 7 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 16BEGIN { $| = 1; print "1..37\n"; } 17END {print "not ok 1\n" unless $loaded;} 18use Text::Balanced qw ( gen_extract_tagged ); 19$loaded = 1; 20print "ok 1\n"; 21$count=2; 22use vars qw( $DEBUG ); 23sub debug { print "\t>>>",@_ if $DEBUG } 24 25######################### End of black magic. 26 27 28$cmd = "print"; 29$neg = 0; 30while (defined($str = <DATA>)) 31{ 32 chomp $str; 33 $str =~ s/\\n/\n/g; 34 if ($str =~ s/\A# USING://) 35 { 36 $neg = 0; 37 eval{local$^W;*f = eval $str || die}; 38 next; 39 } 40 elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } 41 elsif (!$str || $str =~ /\A#/) { $neg = 0; next } 42 $str =~ s/\\n/\n/g; 43 debug "\tUsing: $cmd\n"; 44 debug "\t on: [$str]\n"; 45 46 my @res; 47 $var = eval { @res = f($str) }; 48 debug "\t list got: [" . join("|",@res) . "]\n"; 49 debug "\t list left: [$str]\n"; 50 print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; 51 print "ok ", $count++; 52 print " ($@)" if $@ && $DEBUG; 53 print "\n"; 54 55 pos $str = 0; 56 $var = eval { scalar f($str) }; 57 $var = "<undef>" unless defined $var; 58 debug "\t scalar got: [$var]\n"; 59 debug "\t scalar left: [$str]\n"; 60 print "not " if ($str =~ '\A;')==$neg; 61 print "ok ", $count++; 62 print " ($@)" if $@ && $DEBUG; 63 print "\n"; 64} 65 66__DATA__ 67 68# USING: gen_extract_tagged('{','}'); 69 { a test }; 70 71# USING: gen_extract_tagged(qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]}); 72 <A>aaa<B>bbb<BR>ccc</B>ddd</A>; 73 74# USING: gen_extract_tagged("BEGIN","END"); 75 BEGIN at the BEGIN keyword and END at the END; 76 BEGIN at the beginning and end at the END; 77 78# USING: gen_extract_tagged(undef,undef,undef,{ignore=>["<[^>]*/>"]}); 79 <A>aaa<B>bbb<BR/>ccc</B>ddd</A>; 80 81# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"MAX"}); 82 ; at the ;-) keyword 83 84# USING: gen_extract_tagged("<[A-Z]+>",undef, undef, {ignore=>["<BR>"]}); 85 <A>aaa<B>bbb<BR>ccc</B>ddd</A>; 86 87# THESE SHOULD FAIL 88 BEGIN at the beginning and end at the end; 89 BEGIN at the BEGIN keyword and END at the end; 90 91# TEST EXTRACTION OF TAGGED STRINGS 92# USING: gen_extract_tagged("BEGIN","END",undef,{reject=>["BEGIN","END"]}); 93# THESE SHOULD FAIL 94 BEGIN at the BEGIN keyword and END at the end; 95 96# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"PARA"}); 97 ; at the ;-) keyword 98 99 100# USING: gen_extract_tagged(); 101 <A>some text</A>; 102 <B>some text<A>other text</A></B>; 103 <A>some text<A>other text</A></A>; 104 <A HREF="#section2">some text</A>; 105 106# THESE SHOULD FAIL 107 <A>some text 108 <A>some text<A>other text</A>; 109 <B>some text<A>other text</B>; 110