This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Text::Balanced 1.94.
[perl5.git] / lib / Text / Balanced / t / extvar.t
1 BEGIN {
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
16 BEGIN { $| = 1; print "1..183\n"; }
17 END {print "not ok 1\n" unless $loaded;}
18 use Text::Balanced qw ( extract_variable );
19 $loaded = 1;
20 print "ok 1\n";
21 $count=2;
22 use vars qw( $DEBUG );
23 sub debug { print "\t>>>",@_ if $DEBUG }
24
25 ######################### End of black magic.
26
27
28 $cmd = "print";
29 $neg = 0;
30 while (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;