1use 5.008001; 2 3use strict; 4use warnings; 5use Test::More; 6use Text::Balanced qw ( extract_codeblock ); 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 @res; 28 my $var = eval "\@res = $cmd"; 29 is $@, '', 'no error'; 30 debug "\t list got: [" . join("|", map {defined $_ ? $_ : '<undef>'} @res) . "]\n"; 31 debug "\t list left: [$str]\n"; 32 ($neg ? \&isnt : \&is)->(substr($str,pos($str)||0,1), ';', "$orig_str matched list"); 33 34 pos $str = 0; 35 $var = eval $cmd; 36 is $@, '', 'no error'; 37 $var = "<undef>" unless defined $var; 38 debug "\t scalar got: [$var]\n"; 39 debug "\t scalar left: [$str]\n"; 40 ($neg ? \&unlike : \&like)->( $str, qr/\A;/, "$orig_str matched scalar"); 41} 42 43my $grammar = <<'EOF'; 44given 2 { when __ < 1 { ok(0) } else { ok(1) } } 45EOF 46pos $grammar = 8; 47my ($out) = Text::Balanced::_match_codeblock(\$grammar,qr/\s*/,qr/\{/,qr/\}/,qr/\{/,qr/\}/,undef); 48ok $out, 'Switch error from calling _match_codeblock'; 49 50$grammar = <<'EOF'; 51comment: m/a/ 52enum_list: (/b/) 53EOF 54pos $grammar = 10; 55($out) = Text::Balanced::extract_quotelike($grammar); 56is $out, 'm/a/', 'PRD error (setup for real error)'; 57pos $grammar = 26; 58($out) = extract_codeblock($grammar,'{([',undef,'(',1); 59is $out, '(/b/)', 'PRD error'; 60 61done_testing; 62 63__DATA__ 64 65# USING: extract_codeblock($str,'(){}',undef,'()'); 66(Foo(')')); 67 68# USING: extract_codeblock($str); 69{ $data[4] =~ /['"]/; }; 70{1<<2}; 71{1<<2};\n 72{1<<2};\n\n 73{ $a = /\}/; }; 74{ sub { $_[0] /= $_[1] } }; # / here 75{ 1; }; 76{ $a = 1; }; 77 78# USING: extract_codeblock($str,'<>'); 79< %x = ( try => "this") >; 80< %x = () >; 81< %x = ( $try->{this}, "too") >; 82< %'x = ( $try->{this}, "too") >; 83< %'x'y = ( $try->{this}, "too") >; 84< %::x::y = ( $try->{this}, "too") >; 85 86# THIS SHOULD FAIL 87< %x = do { $try > 10 } >; 88 89# USING: extract_codeblock($str, '()'); 90(($x || 2)); split /z/, $y 91(($x // 2)); split /z/, $y 92 93# USING: extract_codeblock($str,undef,'=*'); 94========{$a=1}; 95 96# USING: extract_codeblock($str,'{}<>'); 97< %x = do { $try > 10 } >; 98 99# USING: extract_codeblock($str,'{}',undef,'<>'); 100< %x = do { $try > 10 } >; 101 102# USING: extract_codeblock($str,'{}'); 103{ $a = $b; # what's this doing here? \n };' 104{ $a = $b; \n $a =~ /$b/; \n @a = map /\s/ @b }; 105 106# THIS SHOULD FAIL 107{ $a = $b; # what's this doing here? };' 108{ $a = $b; # what's this doing here? ;' 109