1256a93a4Safresh1use 5.008001; 2256a93a4Safresh1 3256a93a4Safresh1use strict; 4256a93a4Safresh1use warnings; 5*f2a19305Safresh1use Test::More; 6b39c5158Smillertuse Text::Balanced qw ( extract_variable ); 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 27b39c5158Smillert my @res; 28256a93a4Safresh1 my $var = eval "\@res = $cmd"; 29*f2a19305Safresh1 is $@, '', 'no error'; 30b39c5158Smillert debug "\t list got: [" . join("|",map {defined $_ ? $_ : '<undef>'} @res) . "]\n"; 31b39c5158Smillert debug "\t list left: [$str]\n"; 32*f2a19305Safresh1 ($neg ? \&isnt : \&is)->(substr($str,pos($str)||0,1), ';', "$orig_str matched list"); 33b39c5158Smillert 34b39c5158Smillert pos $str = 0; 35b39c5158Smillert $var = eval $cmd; 36*f2a19305Safresh1 is $@, '', 'no error'; 37b39c5158Smillert $var = "<undef>" unless defined $var; 38b39c5158Smillert debug "\t scalar got: [$var]\n"; 39b39c5158Smillert debug "\t scalar left: [$str]\n"; 40*f2a19305Safresh1 ($neg ? \&unlike : \&like)->( $str, qr/\A;/, "$orig_str matched scalar"); 41b39c5158Smillert} 42b39c5158Smillert 43*f2a19305Safresh1my @res = extract_variable('${a}'); 44*f2a19305Safresh1is $res[0], '${a}' or diag "error was: $@"; 45*f2a19305Safresh1 46*f2a19305Safresh1done_testing; 47*f2a19305Safresh1 48b39c5158Smillert__DATA__ 49b39c5158Smillert 50b39c5158Smillert# USING: extract_variable($str); 51b39c5158Smillert# THESE SHOULD FAIL 52b39c5158Smillert$a->; 53b39c5158Smillert$a (1..3) { print $a }; 54b39c5158Smillert 55b39c5158Smillert# USING: extract_variable($str); 56b39c5158Smillert$::obj; 57b39c5158Smillert$obj->nextval; 58b39c5158Smillert*var; 59b39c5158Smillert*$var; 60b39c5158Smillert*{var}; 61b39c5158Smillert*{$var}; 62b39c5158Smillert*var{cat}; 63b39c5158Smillert\&var; 64b39c5158Smillert\&mod::var; 65b39c5158Smillert\&mod'var; 66b39c5158Smillert$a; 67b39c5158Smillert$_; 68b39c5158Smillert$a[1]; 69b39c5158Smillert$_[1]; 70b39c5158Smillert$a{cat}; 71b39c5158Smillert$_{cat}; 72b39c5158Smillert$a->[1]; 73b39c5158Smillert$a->{"cat"}[1]; 74b39c5158Smillert@$listref; 75b39c5158Smillert@{$listref}; 76b39c5158Smillert$obj->nextval; 77b39c5158Smillert$obj->_nextval; 78b39c5158Smillert$obj->next_val_; 79b39c5158Smillert@{$obj->nextval}; 80b39c5158Smillert@{$obj->nextval($cat,$dog)->{new}}; 81b39c5158Smillert@{$obj->nextval($cat?$dog:$fish)->{new}}; 82b39c5158Smillert@{$obj->nextval(cat()?$dog:$fish)->{new}}; 83b39c5158Smillert$ a {'cat'}; 84b39c5158Smillert$a::b::c{d}->{$e->()}; 85b39c5158Smillert$a'b'c'd{e}->{$e->()}; 86b39c5158Smillert$a'b::c'd{e}->{$e->()}; 87b39c5158Smillert$#_; 88b39c5158Smillert$#array; 89b39c5158Smillert$#{array}; 90b39c5158Smillert$var[$#var]; 91b39c5158Smillert$1; 92b39c5158Smillert$11; 93b39c5158Smillert$&; 94b39c5158Smillert$`; 95b39c5158Smillert$'; 96b39c5158Smillert$+; 97b39c5158Smillert$*; 98b39c5158Smillert$.; 99b39c5158Smillert$/; 100b39c5158Smillert$|; 101b39c5158Smillert$,; 102b39c5158Smillert$"; 103b39c5158Smillert$;; 104b39c5158Smillert$#; 105b39c5158Smillert$%; 106b39c5158Smillert$=; 107b39c5158Smillert$-; 108b39c5158Smillert$~; 109b39c5158Smillert$^; 110b39c5158Smillert$:; 111b39c5158Smillert$^L; 112b39c5158Smillert$^A; 113b39c5158Smillert$?; 114b39c5158Smillert$!; 115b39c5158Smillert$^E; 116b39c5158Smillert$@; 117b39c5158Smillert$$; 118b39c5158Smillert$<; 119b39c5158Smillert$>; 120b39c5158Smillert$(; 121b39c5158Smillert$); 122b39c5158Smillert$[; 123b39c5158Smillert$]; 124b39c5158Smillert$^C; 125b39c5158Smillert$^D; 126b39c5158Smillert$^F; 127b39c5158Smillert$^H; 128b39c5158Smillert$^I; 129b39c5158Smillert$^M; 130b39c5158Smillert$^O; 131b39c5158Smillert$^P; 132b39c5158Smillert$^R; 133b39c5158Smillert$^S; 134b39c5158Smillert$^T; 135b39c5158Smillert$^V; 136b39c5158Smillert$^W; 137b39c5158Smillert${^WARNING_BITS}; 138b39c5158Smillert${^WIDE_SYSTEM_CALLS}; 139b39c5158Smillert$^X; 140b39c5158Smillert 141b39c5158Smillert# THESE SHOULD FAIL 142b39c5158Smillert$a->; 143b39c5158Smillert@{$; 144b39c5158Smillert$ a :: b :: c 145b39c5158Smillert$ a ' b ' c 146b39c5158Smillert 147b39c5158Smillert# USING: extract_variable($str,'=*'); 148b39c5158Smillert========$a; 149