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