1BEGIN {
2    if ($ENV{PERL_CORE}) {
3        chdir('t') if -d 't';
4        @INC = qw(../lib);
5    }
6}
7
8# Before `make install' is performed this script should be runnable with
9# `make test'. After `make install' it should work as `perl test.pl'
10
11######################### We start with some black magic to print on failure.
12
13# Change 1..1 below to 1..last_test_to_print .
14# (It may become useful if the test is moved to ./t subdirectory.)
15
16BEGIN { $| = 1; print "1..183\n"; }
17END {print "not ok 1\n" unless $loaded;}
18use Text::Balanced qw ( extract_variable );
19$loaded = 1;
20print "ok 1\n";
21$count=2;
22use vars qw( $DEBUG );
23sub debug { print "\t>>>",@_ if $DEBUG }
24
25######################### End of black magic.
26
27
28$cmd = "print";
29$neg = 0;
30while (defined($str = <DATA>))
31{
32	chomp $str;
33	if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; }
34	elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; }
35	elsif (!$str || $str =~ /\A#/) { $neg = 0; next }
36	$str =~ s/\\n/\n/g;
37	debug "\tUsing: $cmd\n";
38	debug "\t   on: [$str]\n";
39
40	my @res;
41	$var = eval "\@res = $cmd";
42	debug "\t list got: [" . join("|",@res) . "]\n";
43	debug "\t list left: [$str]\n";
44	print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg;
45	print "ok ", $count++;
46	print " ($@)" if $@ && $DEBUG;
47	print "\n";
48
49	pos $str = 0;
50	$var = eval $cmd;
51	$var = "<undef>" unless defined $var;
52	debug "\t scalar got: [$var]\n";
53	debug "\t scalar left: [$str]\n";
54	print "not " if ($str =~ '\A;')==$neg;
55	print "ok ", $count++;
56	print " ($@)" if $@ && $DEBUG;
57	print "\n";
58}
59
60__DATA__
61
62# USING: extract_variable($str);
63# THESE SHOULD FAIL
64$a->;
65$a (1..3) { print $a };
66
67# USING: extract_variable($str);
68$::obj;
69$obj->nextval;
70*var;
71*$var;
72*{var};
73*{$var};
74*var{cat};
75\&var;
76\&mod::var;
77\&mod'var;
78$a;
79$_;
80$a[1];
81$_[1];
82$a{cat};
83$_{cat};
84$a->[1];
85$a->{"cat"}[1];
86@$listref;
87@{$listref};
88$obj->nextval;
89$obj->_nextval;
90$obj->next_val_;
91@{$obj->nextval};
92@{$obj->nextval($cat,$dog)->{new}};
93@{$obj->nextval($cat?$dog:$fish)->{new}};
94@{$obj->nextval(cat()?$dog:$fish)->{new}};
95$ a {'cat'};
96$a::b::c{d}->{$e->()};
97$a'b'c'd{e}->{$e->()};
98$a'b::c'd{e}->{$e->()};
99$#_;
100$#array;
101$#{array};
102$var[$#var];
103$1;
104$11;
105$&;
106$`;
107$';
108$+;
109$*;
110$.;
111$/;
112$|;
113$,;
114$";
115$;;
116$#;
117$%;
118$=;
119$-;
120$~;
121$^;
122$:;
123$^L;
124$^A;
125$?;
126$!;
127$^E;
128$@;
129$$;
130$<;
131$>;
132$(;
133$);
134$[;
135$];
136$^C;
137$^D;
138$^F;
139$^H;
140$^I;
141$^M;
142$^O;
143$^P;
144$^R;
145$^S;
146$^T;
147$^V;
148$^W;
149${^WARNING_BITS};
150${^WIDE_SYSTEM_CALLS};
151$^X;
152
153# THESE SHOULD FAIL
154$a->;
155@{$;
156$ a :: b :: c
157$ a ' b ' c
158
159# USING: extract_variable($str,'=*');
160========$a;
161