1use 5.008001; 2 3use strict; 4use warnings; 5use Text::Balanced qw ( gen_extract_tagged ); 6use Test::More; 7 8our $DEBUG; 9sub debug { print "\t>>>",@_ if $DEBUG } 10 11## no critic (BuiltinFunctions::ProhibitStringyEval) 12 13my $cmd = "print"; 14my $neg = 0; 15my $str; 16while (defined($str = <DATA>)) 17{ 18 chomp $str; 19 my $orig_str = $str; 20 $str =~ s/\\n/\n/g; 21 if ($str =~ s/\A# USING://) 22 { 23 $neg = 0; 24 eval { 25 # Capture "Subroutine main::f redefined" warning 26 my @warnings; 27 local $SIG{__WARN__} = sub { push @warnings, shift; }; 28 *f = eval $str || die; 29 }; 30 is $@, '', 'no error'; 31 next; 32 } 33 elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } 34 elsif (!$str || $str =~ /\A#/) { $neg = 0; next } 35 $str =~ s/\\n/\n/g; 36 debug "\tUsing: $cmd\n"; 37 debug "\t on: [$str]\n"; 38 39 my @res; 40 my $var = eval { @res = f($str) }; 41 is $@, '', 'no error'; 42 debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n"; 43 debug "\t list left: [$str]\n"; 44 ($neg ? \&isnt : \&is)->(substr($str,pos($str)||0,1), ';', "$orig_str matched list"); 45 46 pos $str = 0; 47 $var = eval { scalar f($str) }; 48 is $@, '', 'no error'; 49 $var = "<undef>" unless defined $var; 50 debug "\t scalar got: [$var]\n"; 51 debug "\t scalar left: [$str]\n"; 52 ($neg ? \&unlike : \&like)->( $str, qr/\A;/, "$orig_str matched scalar"); 53} 54 55done_testing; 56 57__DATA__ 58 59# USING: gen_extract_tagged('{','}'); 60 { a test }; 61 62# USING: gen_extract_tagged(qr/<[A-Z]+>/,undef, undef, {ignore=>["<BR>"]}); 63 <A>aaa<B>bbb<BR>ccc</B>ddd</A>; 64 65# USING: gen_extract_tagged("BEGIN","END"); 66 BEGIN at the BEGIN keyword and END at the END; 67 BEGIN at the beginning and end at the END; 68 69# USING: gen_extract_tagged(undef,undef,undef,{ignore=>["<[^>]*/>"]}); 70 <A>aaa<B>bbb<BR/>ccc</B>ddd</A>; 71 72# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"MAX"}); 73 ; at the ;-) keyword 74 75# USING: gen_extract_tagged("<[A-Z]+>",undef, undef, {ignore=>["<BR>"]}); 76 <A>aaa<B>bbb<BR>ccc</B>ddd</A>; 77 78# THESE SHOULD FAIL 79 BEGIN at the beginning and end at the end; 80 BEGIN at the BEGIN keyword and END at the end; 81 82# TEST EXTRACTION OF TAGGED STRINGS 83# USING: gen_extract_tagged("BEGIN","END",undef,{reject=>["BEGIN","END"]}); 84# THESE SHOULD FAIL 85 BEGIN at the BEGIN keyword and END at the end; 86 87# USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"PARA"}); 88 ; at the ;-) keyword 89 90 91# USING: gen_extract_tagged(); 92 <A>some text</A>; 93 <B>some text<A>other text</A></B>; 94 <A>some text<A>other text</A></A>; 95 <A HREF="#section2">some text</A>; 96 97# THESE SHOULD FAIL 98 <A>some text 99 <A>some text<A>other text</A>; 100 <B>some text<A>other text</B>; 101