Commit | Line | Data |
---|---|---|
a559c259 LW |
1 | #!./perl |
2 | ||
16a5162e | 3 | print "1..46\n"; |
a559c259 LW |
4 | |
5 | eval 'print "ok 1\n";'; | |
6 | ||
7 | if ($@ eq '') {print "ok 2\n";} else {print "not ok 2\n";} | |
8 | ||
9 | eval "\$foo\n = # this is a comment\n'ok 3';"; | |
10 | print $foo,"\n"; | |
11 | ||
12 | eval "\$foo\n = # this is a comment\n'ok 4\n';"; | |
13 | print $foo; | |
14 | ||
378cc40b | 15 | print eval ' |
79072805 | 16 | $foo =;'; # this tests for a call through yyerror() |
a559c259 LW |
17 | if ($@ =~ /line 2/) {print "ok 5\n";} else {print "not ok 5\n";} |
18 | ||
378cc40b | 19 | print eval '$foo = /'; # this tests for a call through fatal() |
a559c259 | 20 | if ($@ =~ /Search/) {print "ok 6\n";} else {print "not ok 6\n";} |
378cc40b LW |
21 | |
22 | print eval '"ok 7\n";'; | |
23 | ||
24 | # calculate a factorial with recursive evals | |
25 | ||
26 | $foo = 5; | |
27 | $fact = 'if ($foo <= 1) {1;} else {push(@x,$foo--); (eval $fact) * pop(@x);}'; | |
28 | $ans = eval $fact; | |
29 | if ($ans == 120) {print "ok 8\n";} else {print "not ok 8\n";} | |
30 | ||
31 | $foo = 5; | |
a687059c | 32 | $fact = 'local($foo)=$foo; $foo <= 1 ? 1 : $foo-- * (eval $fact);'; |
378cc40b LW |
33 | $ans = eval $fact; |
34 | if ($ans == 120) {print "ok 9\n";} else {print "not ok 9 $ans\n";} | |
35 | ||
36 | open(try,'>Op.eval'); | |
37 | print try 'print "ok 10\n"; unlink "Op.eval";',"\n"; | |
38 | close try; | |
39 | ||
4343e7c3 | 40 | do './Op.eval'; print $@; |
99b89507 LW |
41 | |
42 | # Test the singlequoted eval optimizer | |
43 | ||
44 | $i = 11; | |
45 | for (1..3) { | |
46 | eval 'print "ok ", $i++, "\n"'; | |
47 | } | |
48 | ||
49 | eval { | |
50 | print "ok 14\n"; | |
51 | die "ok 16\n"; | |
52 | 1; | |
53 | } || print "ok 15\n$@"; | |
54 | ||
c7cc6f1c GS |
55 | # check whether eval EXPR determines value of EXPR correctly |
56 | ||
57 | { | |
58 | my @a = qw(a b c d); | |
59 | my @b = eval @a; | |
60 | print "@b" eq '4' ? "ok 17\n" : "not ok 17\n"; | |
61 | print $@ ? "not ok 18\n" : "ok 18\n"; | |
62 | ||
63 | my $a = q[defined(wantarray) ? (wantarray ? ($b='A') : ($b='S')) : ($b='V')]; | |
64 | my $b; | |
65 | @a = eval $a; | |
66 | print "@a" eq 'A' ? "ok 19\n" : "# $b\nnot ok 19\n"; | |
67 | print $b eq 'A' ? "ok 20\n" : "# $b\nnot ok 20\n"; | |
68 | $_ = eval $a; | |
69 | print $b eq 'S' ? "ok 21\n" : "# $b\nnot ok 21\n"; | |
70 | eval $a; | |
71 | print $b eq 'V' ? "ok 22\n" : "# $b\nnot ok 22\n"; | |
fc360e46 AB |
72 | |
73 | $b = 'wrong'; | |
74 | $x = sub { | |
75 | my $b = "right"; | |
76 | print eval('"$b"') eq $b ? "ok 23\n" : "not ok 23\n"; | |
77 | }; | |
78 | &$x(); | |
c7cc6f1c | 79 | } |
155fc61f GS |
80 | |
81 | my $b = 'wrong'; | |
82 | my $X = sub { | |
83 | my $b = "right"; | |
84 | print eval('"$b"') eq $b ? "ok 24\n" : "not ok 24\n"; | |
85 | }; | |
86 | &$X(); | |
87 | ||
88 | ||
89 | # check navigation of multiple eval boundaries to find lexicals | |
90 | ||
91 | my $x = 25; | |
92 | eval <<'EOT'; die if $@; | |
0a00efa0 GS |
93 | print "# $x\n"; # clone into eval's pad |
94 | sub do_eval1 { | |
155fc61f GS |
95 | eval $_[0]; die if $@; |
96 | } | |
97 | EOT | |
0a00efa0 | 98 | do_eval1('print "ok $x\n"'); |
155fc61f | 99 | $x++; |
0a00efa0 | 100 | do_eval1('eval q[print "ok $x\n"]'); |
155fc61f | 101 | $x++; |
b318f128 | 102 | do_eval1('sub { print "# $x\n"; eval q[print "ok $x\n"] }->()'); |
0a00efa0 GS |
103 | $x++; |
104 | ||
105 | # calls from within eval'' should clone outer lexicals | |
106 | ||
107 | eval <<'EOT'; die if $@; | |
108 | sub do_eval2 { | |
109 | eval $_[0]; die if $@; | |
110 | } | |
111 | do_eval2('print "ok $x\n"'); | |
112 | $x++; | |
113 | do_eval2('eval q[print "ok $x\n"]'); | |
114 | $x++; | |
b318f128 | 115 | do_eval2('sub { print "# $x\n"; eval q[print "ok $x\n"] }->()'); |
0a00efa0 GS |
116 | $x++; |
117 | EOT | |
118 | ||
119 | # calls outside eval'' should NOT clone lexicals from called context | |
120 | ||
121 | $main::x = 'ok'; | |
122 | eval <<'EOT'; die if $@; | |
123 | # $x unbound here | |
124 | sub do_eval3 { | |
125 | eval $_[0]; die if $@; | |
126 | } | |
127 | EOT | |
128 | do_eval3('print "$x ' . $x . '\n"'); | |
129 | $x++; | |
130 | do_eval3('eval q[print "$x ' . $x . '\n"]'); | |
131 | $x++; | |
132 | do_eval3('sub { eval q[print "$x ' . $x . '\n"] }->()'); | |
155fc61f | 133 | $x++; |
6b35e009 GS |
134 | |
135 | # can recursive subroutine-call inside eval'' see its own lexicals? | |
136 | sub recurse { | |
137 | my $l = shift; | |
138 | if ($l < $x) { | |
139 | ++$l; | |
140 | eval 'print "# level $l\n"; recurse($l);'; | |
141 | die if $@; | |
142 | } | |
143 | else { | |
144 | print "ok $l\n"; | |
145 | } | |
146 | } | |
147 | { | |
148 | local $SIG{__WARN__} = sub { die "not ok $x\n" if $_[0] =~ /^Deep recurs/ }; | |
149 | recurse($x-5); | |
150 | } | |
33b8ce05 GS |
151 | $x++; |
152 | ||
153 | # do closures created within eval bind correctly? | |
154 | eval <<'EOT'; | |
155 | sub create_closure { | |
156 | my $self = shift; | |
157 | return sub { | |
158 | print $self; | |
159 | }; | |
160 | } | |
161 | EOT | |
162 | create_closure("ok $x\n")->(); | |
2680586e GS |
163 | $x++; |
164 | ||
165 | # does lexical search terminate correctly at subroutine boundary? | |
166 | $main::r = "ok $x\n"; | |
167 | sub terminal { eval 'print $r' } | |
168 | { | |
169 | my $r = "not ok $x\n"; | |
170 | eval 'terminal($r)'; | |
171 | } | |
172 | $x++; | |
173 | ||
a7c6d244 NIS |
174 | # Have we cured panic which occurred with require/eval in die handler ? |
175 | $SIG{__DIE__} = sub { eval {1}; die shift }; | |
176 | eval { die "ok ".$x++,"\n" }; | |
177 | print $@; | |
178 | ||
a7ec2b44 GS |
179 | # does scalar eval"" pop stack correctly? |
180 | { | |
181 | my $c = eval "(1,2)x10"; | |
182 | print $c eq '2222222222' ? "ok $x\n" : "# $c\nnot ok $x\n"; | |
183 | $x++; | |
184 | } | |
b45de488 GS |
185 | |
186 | # return from eval {} should clear $@ correctly | |
187 | { | |
188 | my $status = eval { | |
189 | eval { die }; | |
190 | print "# eval { return } test\n"; | |
191 | return; # removing this changes behavior | |
192 | }; | |
193 | print "not " if $@; | |
194 | print "ok $x\n"; | |
195 | $x++; | |
196 | } | |
197 | ||
198 | # ditto for eval "" | |
199 | { | |
200 | my $status = eval q{ | |
201 | eval q{ die }; | |
202 | print "# eval q{ return } test\n"; | |
203 | return; # removing this changes behavior | |
204 | }; | |
205 | print "not " if $@; | |
206 | print "ok $x\n"; | |
207 | $x++; | |
208 | } | |
3b2447bc RH |
209 | |
210 | # Check that eval catches bad goto calls | |
211 | # (BUG ID 20010305.003) | |
212 | { | |
213 | eval { | |
214 | eval { goto foo; }; | |
215 | print ($@ ? "ok 41\n" : "not ok 41\n"); | |
216 | last; | |
217 | foreach my $i (1) { | |
218 | foo: print "not ok 41\n"; | |
219 | print "# jumped into foreach\n"; | |
220 | } | |
221 | }; | |
222 | print "not ok 41\n" if $@; | |
223 | } | |
b6512f48 MJD |
224 | |
225 | # Make sure that "my $$x" is forbidden | |
226 | # 20011224 MJD | |
227 | { | |
228 | eval q{my $$x}; | |
229 | print $@ ? "ok 42\n" : "not ok 42\n"; | |
230 | eval q{my @$x}; | |
231 | print $@ ? "ok 43\n" : "not ok 43\n"; | |
232 | eval q{my %$x}; | |
233 | print $@ ? "ok 44\n" : "not ok 44\n"; | |
234 | eval q{my $$$x}; | |
235 | print $@ ? "ok 45\n" : "not ok 45\n"; | |
236 | } | |
16a5162e JH |
237 | |
238 | # [ID 20020623.002] eval "" doesn't clear $@ | |
239 | { | |
240 | $@ = 5; | |
241 | eval q{}; | |
242 | print length($@) ? "not ok 46\t# \$\@ = '$@'\n" : "ok 46\n"; | |
243 | } |