1256a93a4Safresh1use 5.008001; 2256a93a4Safresh1 3256a93a4Safresh1use strict; 4256a93a4Safresh1use warnings; 5*f2a19305Safresh1use Test::More; 6b39c5158Smillertuse Text::Balanced qw ( extract_bracketed ); 7b39c5158Smillert 8*f2a19305Safresh1our $DEBUG; 9*f2a19305Safresh1sub debug { print "\t>>>",@_ if $DEBUG } 10b39c5158Smillert 11256a93a4Safresh1## no critic (BuiltinFunctions::ProhibitStringyEval) 12b39c5158Smillert 13256a93a4Safresh1my $cmd = "print"; 14256a93a4Safresh1my $neg = 0; 15256a93a4Safresh1my $str; 16b39c5158Smillertwhile (defined($str = <DATA>)) 17b39c5158Smillert{ 18b39c5158Smillert chomp $str; 19b39c5158Smillert if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } 20b39c5158Smillert elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } 21b39c5158Smillert elsif (!$str || $str =~ /\A#/) { $neg = 0; next } 22*f2a19305Safresh1 my $orig_str = $str; 23b39c5158Smillert $str =~ s/\\n/\n/g; 24b39c5158Smillert debug "\tUsing: $cmd\n"; 25b39c5158Smillert debug "\t on: [$str]\n"; 26b39c5158Smillert 27256a93a4Safresh1 my $var = eval "() = $cmd"; 28b39c5158Smillert debug "\t list got: [$var]\n"; 29b39c5158Smillert debug "\t list left: [$str]\n"; 30*f2a19305Safresh1 ($neg ? \&isnt : \&is)->(substr($str,pos($str)||0,1), ';', "$orig_str matched list"); 31*f2a19305Safresh1 diag $@ if $@ && $DEBUG; 32b39c5158Smillert 33b39c5158Smillert pos $str = 0; 34b39c5158Smillert $var = eval $cmd; 35b39c5158Smillert $var = "<undef>" unless defined $var; 36b39c5158Smillert debug "\t scalar got: [$var]\n"; 37b39c5158Smillert debug "\t scalar left: [$str]\n"; 38*f2a19305Safresh1 ($neg ? \&unlike : \&like)->( $str, qr/\A;/, "$orig_str matched scalar"); 39*f2a19305Safresh1 diag $@ if $@ && $DEBUG; 40b39c5158Smillert} 41b39c5158Smillert 42*f2a19305Safresh1done_testing; 43*f2a19305Safresh1 44b39c5158Smillert__DATA__ 45b39c5158Smillert 46b39c5158Smillert# USING: extract_bracketed($str); 47b39c5158Smillert{a nested { and } are okay as are () and <> pairs and escaped \}'s }; 48b39c5158Smillert{a nested\n{ and } are okay as are\n() and <> pairs and escaped \}'s }; 49b39c5158Smillert 50b39c5158Smillert# USING: extract_bracketed($str,'{}'); 51b39c5158Smillert{a nested { and } are okay as are unbalanced ( and < pairs and escaped \}'s }; 52b39c5158Smillert 53b39c5158Smillert# THESE SHOULD FAIL 54b39c5158Smillert{an unmatched nested { isn't okay, nor are ( and < }; 55b39c5158Smillert{an unbalanced nested [ even with } and ] to match them; 56b39c5158Smillert 57b39c5158Smillert 58b39c5158Smillert# USING: extract_bracketed($str,'<"`q>'); 59b39c5158Smillert<a q{uoted} ">" unbalanced right bracket of /(q>)/ either sort (`>>>""">>>>`) is okay >; 60b39c5158Smillert 61b39c5158Smillert# USING: extract_bracketed($str,'<">'); 62b39c5158Smillert<a quoted ">" unbalanced right bracket is okay >; 63b39c5158Smillert 64b39c5158Smillert# USING: extract_bracketed($str,'<"`>'); 65b39c5158Smillert<a quoted ">" unbalanced right bracket of either sort (`>>>""">>>>`) is okay >; 66b39c5158Smillert 67b39c5158Smillert# THIS SHOULD FAIL 68b39c5158Smillert<a misquoted '>' unbalanced right bracket is bad >; 69