Commit | Line | Data |
---|---|---|
a0d0e21e LW |
1 | #!./perl |
2 | ||
fb73857a | 3 | # NOTE: Please don't add tests to this file unless they *need* to be run in |
4 | # separate executable and can't simply use eval. | |
5 | ||
a0d0e21e LW |
6 | chdir 't' if -d 't'; |
7 | @INC = "../lib"; | |
8 | $ENV{PERL5LIB} = "../lib"; | |
9 | ||
10 | $|=1; | |
11 | ||
12 | undef $/; | |
13 | @prgs = split "\n########\n", <DATA>; | |
14 | print "1..", scalar @prgs, "\n"; | |
15 | ||
16 | $tmpfile = "misctmp000"; | |
17 | 1 while -f ++$tmpfile; | |
18 | END { unlink $tmpfile if $tmpfile; } | |
19 | ||
68dc0745 | 20 | $CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat'); |
21 | ||
a0d0e21e LW |
22 | for (@prgs){ |
23 | my $switch; | |
fb73857a | 24 | if (s/^\s*(-\w.*)//){ |
25 | $switch = $1; | |
a0d0e21e LW |
26 | } |
27 | my($prog,$expected) = split(/\nEXPECT\n/, $_); | |
68dc0745 | 28 | if ($^O eq 'MSWin32') { |
29 | open TEST, "| .\\perl -I../lib $switch >$tmpfile 2>&1"; | |
30 | } | |
31 | else { | |
32 | open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1"; | |
33 | } | |
a0d0e21e LW |
34 | print TEST $prog, "\n"; |
35 | close TEST; | |
36 | $status = $?; | |
68dc0745 | 37 | $results = `$CAT $tmpfile`; |
a0d0e21e LW |
38 | $results =~ s/\n+$//; |
39 | $expected =~ s/\n+$//; | |
40 | if ( $results ne $expected){ | |
41 | print STDERR "PROG: $switch\n$prog\n"; | |
42 | print STDERR "EXPECTED:\n$expected\n"; | |
43 | print STDERR "GOT:\n$results\n"; | |
44 | print "not "; | |
45 | } | |
46 | print "ok ", ++$i, "\n"; | |
47 | } | |
48 | ||
49 | __END__ | |
2ace3117 CS |
50 | ()=() |
51 | ######## | |
44a8e56a | 52 | $a = ":="; split /($a)/o, "a:=b:=c"; print "@_" |
53 | EXPECT | |
54 | a := b := c | |
55 | ######## | |
36477c24 | 56 | $cusp = ~0 ^ (~0 >> 1); |
57 | $, = " "; | |
58 | print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n"; | |
59 | EXPECT | |
60 | 7 0 0 1 ! | |
61 | ######## | |
a0d0e21e LW |
62 | $foo=undef; $foo->go; |
63 | EXPECT | |
64 | Can't call method "go" without a package or object reference at - line 1. | |
65 | ######## | |
66 | BEGIN | |
67 | { | |
68 | "foo"; | |
69 | } | |
70 | ######## | |
a0d0e21e LW |
71 | $array[128]=1 |
72 | ######## | |
73 | $x=0x0eabcd; print $x->ref; | |
74 | EXPECT | |
75 | Can't call method "ref" without a package or object reference at - line 1. | |
76 | ######## | |
77 | chop ($str .= <STDIN>); | |
78 | ######## | |
79 | close ($banana); | |
80 | ######## | |
81 | $x=2;$y=3;$x<$y ? $x : $y += 23;print $x; | |
82 | EXPECT | |
83 | 25 | |
84 | ######## | |
85 | eval {sub bar {print "In bar";}} | |
86 | ######## | |
68dc0745 | 87 | system './perl -ne "print if eof" /dev/null' |
a0d0e21e LW |
88 | ######## |
89 | chop($file = <>); | |
90 | ######## | |
91 | package N; | |
92 | sub new {my ($obj,$n)=@_; bless \$n} | |
93 | $aa=new N 1; | |
94 | $aa=12345; | |
95 | print $aa; | |
96 | EXPECT | |
97 | 12345 | |
98 | ######## | |
99 | %@x=0; | |
100 | EXPECT | |
3fe9a6f1 | 101 | Can't modify hash deref in repeat at - line 1, near "0;" |
102 | Execution of - aborted due to compilation errors. | |
a0d0e21e LW |
103 | ######## |
104 | $_="foo"; | |
105 | printf(STDOUT "%s\n", $_); | |
106 | EXPECT | |
107 | foo | |
108 | ######## | |
109 | push(@a, 1, 2, 3,) | |
110 | ######## | |
111 | quotemeta "" | |
112 | ######## | |
113 | for ("ABCDE") { | |
114 | ⊂ | |
115 | s/./&sub($&)/eg; | |
116 | print;} | |
117 | sub sub {local($_) = @_; | |
118 | $_ x 4;} | |
119 | EXPECT | |
120 | Modification of a read-only value attempted at - line 3. | |
121 | ######## | |
122 | package FOO;sub new {bless {FOO => BAR}}; | |
123 | package main; | |
124 | use strict vars; | |
125 | my $self = new FOO; | |
126 | print $$self{FOO}; | |
127 | EXPECT | |
128 | BAR | |
129 | ######## | |
130 | $_="foo"; | |
131 | s/.{1}//s; | |
132 | print; | |
133 | EXPECT | |
134 | oo | |
135 | ######## | |
136 | print scalar ("foo","bar") | |
137 | EXPECT | |
138 | bar | |
139 | ######## | |
140 | sub by_number { $a <=> $b; };# inline function for sort below | |
141 | $as_ary{0}="a0"; | |
142 | @ordered_array=sort by_number keys(%as_ary); | |
143 | ######## | |
144 | sub NewShell | |
145 | { | |
146 | local($Host) = @_; | |
147 | my($m2) = $#Shells++; | |
148 | $Shells[$m2]{HOST} = $Host; | |
149 | return $m2; | |
150 | } | |
151 | ||
152 | sub ShowShell | |
153 | { | |
154 | local($i) = @_; | |
155 | } | |
156 | ||
157 | &ShowShell(&NewShell(beach,Work,"+0+0")); | |
158 | &ShowShell(&NewShell(beach,Work,"+0+0")); | |
159 | &ShowShell(&NewShell(beach,Work,"+0+0")); | |
160 | ######## | |
161 | { | |
162 | package FAKEARRAY; | |
163 | ||
164 | sub TIEARRAY | |
165 | { print "TIEARRAY @_\n"; | |
166 | die "bomb out\n" unless $count ++ ; | |
167 | bless ['foo'] | |
168 | } | |
169 | sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] } | |
170 | sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] } | |
171 | sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; } | |
172 | } | |
173 | ||
174 | eval 'tie @h, FAKEARRAY, fred' ; | |
175 | tie @h, FAKEARRAY, fred ; | |
176 | EXPECT | |
177 | TIEARRAY FAKEARRAY fred | |
178 | TIEARRAY FAKEARRAY fred | |
179 | DESTROY | |
180 | ######## | |
181 | BEGIN { die "phooey\n" } | |
182 | EXPECT | |
183 | phooey | |
184 | BEGIN failed--compilation aborted at - line 1. | |
185 | ######## | |
186 | BEGIN { 1/$zero } | |
187 | EXPECT | |
188 | Illegal division by zero at - line 1. | |
189 | BEGIN failed--compilation aborted at - line 1. | |
190 | ######## | |
191 | BEGIN { undef = 0 } | |
192 | EXPECT | |
193 | Modification of a read-only value attempted at - line 1. | |
194 | BEGIN failed--compilation aborted at - line 1. | |
a7adf1f0 | 195 | ######## |
196 | { | |
197 | package foo; | |
198 | sub PRINT { | |
199 | shift; | |
200 | print join(' ', reverse @_)."\n"; | |
201 | } | |
46fc3d4c | 202 | sub PRINTF { |
203 | shift; | |
204 | my $fmt = shift; | |
205 | print sprintf($fmt, @_)."\n"; | |
206 | } | |
a7adf1f0 | 207 | sub TIEHANDLE { |
208 | bless {}, shift; | |
209 | } | |
58f51617 SV |
210 | sub READLINE { |
211 | "Out of inspiration"; | |
212 | } | |
a7adf1f0 | 213 | sub DESTROY { |
214 | print "and destroyed as well\n"; | |
2ae324a7 | 215 | } |
216 | sub READ { | |
217 | shift; | |
218 | print STDOUT "foo->can(READ)(@_)\n"; | |
219 | return 100; | |
220 | } | |
221 | sub GETC { | |
222 | shift; | |
223 | print STDOUT "Don't GETC, Get Perl\n"; | |
224 | return "a"; | |
225 | } | |
a7adf1f0 | 226 | } |
227 | { | |
228 | local(*FOO); | |
229 | tie(*FOO,'foo'); | |
230 | print FOO "sentence.", "reversed", "a", "is", "This"; | |
58f51617 | 231 | print "-- ", <FOO>, " --\n"; |
2ae324a7 | 232 | my($buf,$len,$offset); |
233 | $buf = "string"; | |
234 | $len = 10; $offset = 1; | |
235 | read(FOO, $buf, $len, $offset) == 100 or die "foo->READ failed"; | |
236 | getc(FOO) eq "a" or die "foo->GETC failed"; | |
46fc3d4c | 237 | printf "%s is number %d\n", "Perl", 1; |
a7adf1f0 | 238 | } |
239 | EXPECT | |
240 | This is a reversed sentence. | |
58f51617 | 241 | -- Out of inspiration -- |
2ae324a7 | 242 | foo->can(READ)(string 10 1) |
243 | Don't GETC, Get Perl | |
46fc3d4c | 244 | Perl is number 1 |
a7adf1f0 | 245 | and destroyed as well |
a6006777 | 246 | ######## |
247 | my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n" | |
248 | EXPECT | |
249 | 2 2 2 | |
250 | ######## | |
251 | @a = ($a, $b, $c, $d) = (5, 6); | |
252 | print "ok\n" | |
253 | if ($a[0] == 5 and $a[1] == 6 and !defined $a[2] and !defined $a[3]); | |
254 | EXPECT | |
255 | ok | |
256 | ######## | |
257 | print "ok\n" if (1E2<<1 == 200 and 3E4<<3 == 240000); | |
258 | EXPECT | |
259 | ok | |
260 | ######## | |
8ebc5c01 | 261 | print "ok\n" if ("\0" lt "\xFF"); |
a6006777 | 262 | EXPECT |
263 | ok | |
264 | ######## | |
265 | open(H,'op/misc.t'); # must be in the 't' directory | |
266 | stat(H); | |
267 | print "ok\n" if (-e _ and -f _ and -r _); | |
268 | EXPECT | |
269 | ok | |
270 | ######## | |
271 | sub thing { 0 || return qw(now is the time) } | |
272 | print thing(), "\n"; | |
273 | EXPECT | |
274 | nowisthetime | |
275 | ######## | |
276 | $ren = 'joy'; | |
277 | $stimpy = 'happy'; | |
278 | { local $main::{ren} = *stimpy; print $ren, ' ' } | |
279 | print $ren, "\n"; | |
280 | EXPECT | |
281 | happy joy | |
282 | ######## | |
283 | $stimpy = 'happy'; | |
284 | { local $main::{ren} = *stimpy; print ${'ren'}, ' ' } | |
285 | print +(defined(${'ren'}) ? 'oops' : 'joy'), "\n"; | |
286 | EXPECT | |
287 | happy joy | |
288 | ######## | |
289 | package p; | |
290 | sub func { print 'really ' unless wantarray; 'p' } | |
291 | sub groovy { 'groovy' } | |
292 | package main; | |
293 | print p::func()->groovy(), "\n" | |
294 | EXPECT | |
295 | really groovy | |
296 | ######## | |
d53f8f1c HS |
297 | @list = ([ 'one', 1 ], [ 'two', 2 ]); |
298 | sub func { $num = shift; (grep $_->[1] == $num, @list)[0] } | |
299 | print scalar(map &func($_), 1 .. 3), " ", | |
300 | scalar(map scalar &func($_), 1 .. 3), "\n"; | |
301 | EXPECT | |
302 | 2 3 | |
303 | ######## | |
44a8e56a | 304 | ($k, $s) = qw(x 0); |
305 | @{$h{$k}} = qw(1 2 4); | |
306 | for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) } | |
307 | print "bogus\n" unless $s == 7; | |
308 | ######## | |
309 | my $a = 'outer'; | |
310 | eval q[ my $a = 'inner'; eval q[ print "$a " ] ]; | |
311 | eval { my $x = 'peace'; eval q[ print "$x\n" ] } | |
312 | EXPECT | |
313 | inner peace | |
774d564b | 314 | ######## |
315 | -w | |
316 | $| = 1; | |
317 | sub foo { | |
318 | print "In foo1\n"; | |
319 | eval 'sub foo { print "In foo2\n" }'; | |
320 | print "Exiting foo1\n"; | |
321 | } | |
322 | foo; | |
323 | foo; | |
324 | EXPECT | |
325 | In foo1 | |
326 | Subroutine foo redefined at (eval 1) line 1. | |
327 | Exiting foo1 | |
328 | In foo2 | |
329 | ######## | |
330 | $s = 0; | |
331 | map {#this newline here tickles the bug | |
332 | $s += $_} (1,2,4); | |
333 | print "eat flaming death\n" unless ($s == 7); | |
1ca7b98a CS |
334 | ######## |
335 | sub foo { local $_ = shift; split; @_ } | |
336 | @x = foo(' x y z '); | |
337 | print "you die joe!\n" unless "@x" eq 'x y z'; | |
c277df42 IZ |
338 | ######## |
339 | /(?{"{"})/ # Check it outside of eval too | |
340 | EXPECT | |
cc6b7395 | 341 | Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern |
c277df42 IZ |
342 | /(?{"{"})/: Sequence (?{...}) not terminated or not {}-balanced at - line 1. |
343 | ######## | |
344 | /(?{"{"}})/ # Check it outside of eval too | |
345 | EXPECT | |
346 | Unmatched right bracket at (re_eval 1) line 1, at end of line | |
347 | syntax error at (re_eval 1) line 1, near ""{"}" | |
348 | Compilation failed in regexp at - line 1. | |
0da4822f GS |
349 | ######## |
350 | BEGIN { @ARGV = qw(a b c) } | |
351 | BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" } | |
352 | END { print "end <",shift,">\nargv <@ARGV>\n" } | |
353 | INIT { print "init <",shift,">\n" } | |
354 | EXPECT | |
355 | argv <a b c> | |
356 | begin <a> | |
357 | init <b> | |
358 | end <c> | |
359 | argv <> | |
4599a1de | 360 | ######## |
3500f679 RS |
361 | -l |
362 | # fdopen from a system descriptor to a system descriptor used to close | |
363 | # the former. | |
364 | open STDERR, '>&=STDOUT' or die $!; | |
365 | select STDOUT; $| = 1; print fileno STDOUT; | |
366 | select STDERR; $| = 1; print fileno STDERR; | |
367 | EXPECT | |
368 | 1 | |
369 | 2 | |
370 | ######## |