1use 5.008001; 2 3use strict; 4use warnings; 5use Test::More; 6use Text::Balanced qw ( extract_variable ); 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 @res = extract_variable('${a}'); 44is $res[0], '${a}' or diag "error was: $@"; 45 46done_testing; 47 48__DATA__ 49 50# USING: extract_variable($str); 51# THESE SHOULD FAIL 52$a->; 53$a (1..3) { print $a }; 54 55# USING: extract_variable($str); 56$::obj; 57$obj->nextval; 58*var; 59*$var; 60*{var}; 61*{$var}; 62*var{cat}; 63\&var; 64\&mod::var; 65\&mod'var; 66$a; 67$_; 68$a[1]; 69$_[1]; 70$a{cat}; 71$_{cat}; 72$a->[1]; 73$a->{"cat"}[1]; 74@$listref; 75@{$listref}; 76$obj->nextval; 77$obj->_nextval; 78$obj->next_val_; 79@{$obj->nextval}; 80@{$obj->nextval($cat,$dog)->{new}}; 81@{$obj->nextval($cat?$dog:$fish)->{new}}; 82@{$obj->nextval(cat()?$dog:$fish)->{new}}; 83$ a {'cat'}; 84$a::b::c{d}->{$e->()}; 85$a'b'c'd{e}->{$e->()}; 86$a'b::c'd{e}->{$e->()}; 87$#_; 88$#array; 89$#{array}; 90$var[$#var]; 91$1; 92$11; 93$&; 94$`; 95$'; 96$+; 97$*; 98$.; 99$/; 100$|; 101$,; 102$"; 103$;; 104$#; 105$%; 106$=; 107$-; 108$~; 109$^; 110$:; 111$^L; 112$^A; 113$?; 114$!; 115$^E; 116$@; 117$$; 118$<; 119$>; 120$(; 121$); 122$[; 123$]; 124$^C; 125$^D; 126$^F; 127$^H; 128$^I; 129$^M; 130$^O; 131$^P; 132$^R; 133$^S; 134$^T; 135$^V; 136$^W; 137${^WARNING_BITS}; 138${^WIDE_SYSTEM_CALLS}; 139$^X; 140 141# THESE SHOULD FAIL 142$a->; 143@{$; 144$ a :: b :: c 145$ a ' b ' c 146 147# USING: extract_variable($str,'=*'); 148========$a; 149