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..53\n"; } 17END {print "not ok 1\n" unless $loaded;} 18use Text::Balanced qw ( extract_tagged 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 if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } 34 elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } 35 elsif (!$str || $str =~ /\A#/) { $neg = 0; next } 36 $str =~ s/\\n/\n/g; 37 debug "\tUsing: $cmd\n"; 38 debug "\t on: [$str]\n"; 39 40 my @res; 41 $var = eval "\@res = $cmd"; 42 debug "\t list got: [" . join("|",@res) . "]\n"; 43 debug "\t list left: [$str]\n"; 44 print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; 45 print "ok ", $count++; 46 print " ($@)" if $@ && $DEBUG; 47 print "\n"; 48 49 pos $str = 0; 50 $var = eval $cmd; 51 $var = "<undef>" unless defined $var; 52 debug "\t scalar got: [$var]\n"; 53 debug "\t scalar left: [$str]\n"; 54 print "not " if ($str =~ '\A;')==$neg; 55 print "ok ", $count++; 56 print " ($@)" if $@ && $DEBUG; 57 print "\n"; 58} 59 60__DATA__ 61# USING: gen_extract_tagged("BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)")->($str); 62 ignore\n this and then BEGINHERE at the ENDHERE; 63 ignore\n this and then BEGINTHIS at the ENDTHIS; 64 65# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)"); 66 ignore\n this and then BEGINHERE at the ENDHERE; 67 ignore\n this and then BEGINTHIS at the ENDTHIS; 68 69# USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)"); 70 ignore\n this and then BEGINHERE at the ENDHERE; 71 ignore\n this and then BEGINTHIS at the ENDTHIS; 72 73# THIS SHOULD FAIL 74 ignore\n this and then BEGINTHIS at the ENDTHAT; 75 76# USING: extract_tagged($str,"BEGIN","END","(?s).*?(?=BEGIN)"); 77 ignore\n this and then BEGIN at the END; 78 79# USING: extract_tagged($str); 80 <A-1 HREF="#section2">some text</A-1>; 81 82# USING: extract_tagged($str,qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]}); 83 <A>aaa<B>bbb<BR>ccc</B>ddd</A>; 84 85# USING: extract_tagged($str,"BEGIN","END"); 86 BEGIN at the BEGIN keyword and END at the END; 87 BEGIN at the beginning and end at the END; 88 89# USING: extract_tagged($str,undef,undef,undef,{ignore=>["<[^>]*/>"]}); 90 <A>aaa<B>bbb<BR/>ccc</B>ddd</A>; 91 92# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"MAX"}); 93 ; at the ;-) keyword 94 95# USING: extract_tagged($str,"<[A-Z]+>",undef, undef, {ignore=>["<BR>"]}); 96 <A>aaa<B>bbb<BR>ccc</B>ddd</A>; 97 98# THESE SHOULD FAIL 99 BEGIN at the beginning and end at the end; 100 BEGIN at the BEGIN keyword and END at the end; 101 102# TEST EXTRACTION OF TAGGED STRINGS 103# USING: extract_tagged($str,"BEGIN","END",undef,{reject=>["BEGIN","END"]}); 104# THESE SHOULD FAIL 105 BEGIN at the BEGIN keyword and END at the end; 106 107# USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"PARA"}); 108 ; at the ;-) keyword 109 110 111# USING: extract_tagged($str); 112 <A>some text</A>; 113 <B>some text<A>other text</A></B>; 114 <A>some text<A>other text</A></A>; 115 <A HREF="#section2">some text</A>; 116 117# THESE SHOULD FAIL 118 <A>some text 119 <A>some text<A>other text</A>; 120 <B>some text<A>other text</B>; 121