1use 5.008001; 2 3use strict; 4use warnings; 5use Test::More; 6use Text::Balanced qw ( extract_bracketed ); 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 if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } 20 elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } 21 elsif (!$str || $str =~ /\A#/) { $neg = 0; next } 22 my $orig_str = $str; 23 $str =~ s/\\n/\n/g; 24 debug "\tUsing: $cmd\n"; 25 debug "\t on: [$str]\n"; 26 27 my $var = eval "() = $cmd"; 28 debug "\t list got: [$var]\n"; 29 debug "\t list left: [$str]\n"; 30 ($neg ? \&isnt : \&is)->(substr($str,pos($str)||0,1), ';', "$orig_str matched list"); 31 diag $@ if $@ && $DEBUG; 32 33 pos $str = 0; 34 $var = eval $cmd; 35 $var = "<undef>" unless defined $var; 36 debug "\t scalar got: [$var]\n"; 37 debug "\t scalar left: [$str]\n"; 38 ($neg ? \&unlike : \&like)->( $str, qr/\A;/, "$orig_str matched scalar"); 39 diag $@ if $@ && $DEBUG; 40} 41 42done_testing; 43 44__DATA__ 45 46# USING: extract_bracketed($str); 47{a nested { and } are okay as are () and <> pairs and escaped \}'s }; 48{a nested\n{ and } are okay as are\n() and <> pairs and escaped \}'s }; 49 50# USING: extract_bracketed($str,'{}'); 51{a nested { and } are okay as are unbalanced ( and < pairs and escaped \}'s }; 52 53# THESE SHOULD FAIL 54{an unmatched nested { isn't okay, nor are ( and < }; 55{an unbalanced nested [ even with } and ] to match them; 56 57 58# USING: extract_bracketed($str,'<"`q>'); 59<a q{uoted} ">" unbalanced right bracket of /(q>)/ either sort (`>>>""">>>>`) is okay >; 60 61# USING: extract_bracketed($str,'<">'); 62<a quoted ">" unbalanced right bracket is okay >; 63 64# USING: extract_bracketed($str,'<"`>'); 65<a quoted ">" unbalanced right bracket of either sort (`>>>""">>>>`) is okay >; 66 67# THIS SHOULD FAIL 68<a misquoted '>' unbalanced right bracket is bad >; 69