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