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 | |
17 | for (@prgs){ |
18 | my $switch; |
19 | if (s/^\s*-\w+//){ |
20 | $switch = $&; |
21 | } |
22 | my($prog,$expected) = split(/\nEXPECT\n/, $_); |
23 | open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1"; |
24 | print TEST $prog, "\n"; |
25 | close TEST; |
26 | $status = $?; |
27 | $results = `cat $tmpfile`; |
28 | $results =~ s/\n+$//; |
29 | $expected =~ s/\n+$//; |
30 | if ( $results ne $expected){ |
31 | print STDERR "PROG: $switch\n$prog\n"; |
32 | print STDERR "EXPECTED:\n$expected\n"; |
33 | print STDERR "GOT:\n$results\n"; |
34 | print "not "; |
35 | } |
36 | print "ok ", ++$i, "\n"; |
37 | } |
38 | |
39 | __END__ |
2ace3117 |
40 | ()=() |
41 | ######## |
44a8e56a |
42 | $a = ":="; split /($a)/o, "a:=b:=c"; print "@_" |
43 | EXPECT |
44 | a := b := c |
45 | ######## |
36477c24 |
46 | $cusp = ~0 ^ (~0 >> 1); |
47 | $, = " "; |
48 | print +($cusp - 1) % 8, $cusp % 8, -$cusp % 8, ($cusp + 1) % 8, "!\n"; |
49 | EXPECT |
50 | 7 0 0 1 ! |
51 | ######## |
a0d0e21e |
52 | $foo=undef; $foo->go; |
53 | EXPECT |
54 | Can't call method "go" without a package or object reference at - line 1. |
55 | ######## |
56 | BEGIN |
57 | { |
58 | "foo"; |
59 | } |
60 | ######## |
a0d0e21e |
61 | $array[128]=1 |
62 | ######## |
63 | $x=0x0eabcd; print $x->ref; |
64 | EXPECT |
65 | Can't call method "ref" without a package or object reference at - line 1. |
66 | ######## |
67 | chop ($str .= <STDIN>); |
68 | ######## |
69 | close ($banana); |
70 | ######## |
71 | $x=2;$y=3;$x<$y ? $x : $y += 23;print $x; |
72 | EXPECT |
73 | 25 |
74 | ######## |
75 | eval {sub bar {print "In bar";}} |
76 | ######## |
77 | system "./perl -ne 'print if eof' /dev/null" |
78 | ######## |
79 | chop($file = <>); |
80 | ######## |
81 | package N; |
82 | sub new {my ($obj,$n)=@_; bless \$n} |
83 | $aa=new N 1; |
84 | $aa=12345; |
85 | print $aa; |
86 | EXPECT |
87 | 12345 |
88 | ######## |
89 | %@x=0; |
90 | EXPECT |
91 | Can't coerce HASH to string in repeat at - line 1. |
92 | ######## |
93 | $_="foo"; |
94 | printf(STDOUT "%s\n", $_); |
95 | EXPECT |
96 | foo |
97 | ######## |
98 | push(@a, 1, 2, 3,) |
99 | ######## |
100 | quotemeta "" |
101 | ######## |
102 | for ("ABCDE") { |
103 | ⊂ |
104 | s/./&sub($&)/eg; |
105 | print;} |
106 | sub sub {local($_) = @_; |
107 | $_ x 4;} |
108 | EXPECT |
109 | Modification of a read-only value attempted at - line 3. |
110 | ######## |
111 | package FOO;sub new {bless {FOO => BAR}}; |
112 | package main; |
113 | use strict vars; |
114 | my $self = new FOO; |
115 | print $$self{FOO}; |
116 | EXPECT |
117 | BAR |
118 | ######## |
119 | $_="foo"; |
120 | s/.{1}//s; |
121 | print; |
122 | EXPECT |
123 | oo |
124 | ######## |
125 | print scalar ("foo","bar") |
126 | EXPECT |
127 | bar |
128 | ######## |
129 | sub by_number { $a <=> $b; };# inline function for sort below |
130 | $as_ary{0}="a0"; |
131 | @ordered_array=sort by_number keys(%as_ary); |
132 | ######## |
133 | sub NewShell |
134 | { |
135 | local($Host) = @_; |
136 | my($m2) = $#Shells++; |
137 | $Shells[$m2]{HOST} = $Host; |
138 | return $m2; |
139 | } |
140 | |
141 | sub ShowShell |
142 | { |
143 | local($i) = @_; |
144 | } |
145 | |
146 | &ShowShell(&NewShell(beach,Work,"+0+0")); |
147 | &ShowShell(&NewShell(beach,Work,"+0+0")); |
148 | &ShowShell(&NewShell(beach,Work,"+0+0")); |
149 | ######## |
150 | { |
151 | package FAKEARRAY; |
152 | |
153 | sub TIEARRAY |
154 | { print "TIEARRAY @_\n"; |
155 | die "bomb out\n" unless $count ++ ; |
156 | bless ['foo'] |
157 | } |
158 | sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] } |
159 | sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] } |
160 | sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; } |
161 | } |
162 | |
163 | eval 'tie @h, FAKEARRAY, fred' ; |
164 | tie @h, FAKEARRAY, fred ; |
165 | EXPECT |
166 | TIEARRAY FAKEARRAY fred |
167 | TIEARRAY FAKEARRAY fred |
168 | DESTROY |
169 | ######## |
170 | BEGIN { die "phooey\n" } |
171 | EXPECT |
172 | phooey |
173 | BEGIN failed--compilation aborted at - line 1. |
174 | ######## |
175 | BEGIN { 1/$zero } |
176 | EXPECT |
177 | Illegal division by zero at - line 1. |
178 | BEGIN failed--compilation aborted at - line 1. |
179 | ######## |
180 | BEGIN { undef = 0 } |
181 | EXPECT |
182 | Modification of a read-only value attempted at - line 1. |
183 | BEGIN failed--compilation aborted at - line 1. |
a7adf1f0 |
184 | ######## |
185 | { |
186 | package foo; |
187 | sub PRINT { |
188 | shift; |
189 | print join(' ', reverse @_)."\n"; |
190 | } |
191 | sub TIEHANDLE { |
192 | bless {}, shift; |
193 | } |
58f51617 |
194 | sub READLINE { |
195 | "Out of inspiration"; |
196 | } |
a7adf1f0 |
197 | sub DESTROY { |
198 | print "and destroyed as well\n"; |
199 | } |
200 | } |
201 | { |
202 | local(*FOO); |
203 | tie(*FOO,'foo'); |
204 | print FOO "sentence.", "reversed", "a", "is", "This"; |
58f51617 |
205 | print "-- ", <FOO>, " --\n"; |
a7adf1f0 |
206 | } |
207 | EXPECT |
208 | This is a reversed sentence. |
58f51617 |
209 | -- Out of inspiration -- |
a7adf1f0 |
210 | and destroyed as well |
a6006777 |
211 | ######## |
212 | my @a; $a[2] = 1; for (@a) { $_ = 2 } print "@a\n" |
213 | EXPECT |
214 | 2 2 2 |
215 | ######## |
216 | @a = ($a, $b, $c, $d) = (5, 6); |
217 | print "ok\n" |
218 | if ($a[0] == 5 and $a[1] == 6 and !defined $a[2] and !defined $a[3]); |
219 | EXPECT |
220 | ok |
221 | ######## |
222 | print "ok\n" if (1E2<<1 == 200 and 3E4<<3 == 240000); |
223 | EXPECT |
224 | ok |
225 | ######## |
8ebc5c01 |
226 | print "ok\n" if ("\0" lt "\xFF"); |
a6006777 |
227 | EXPECT |
228 | ok |
229 | ######## |
230 | open(H,'op/misc.t'); # must be in the 't' directory |
231 | stat(H); |
232 | print "ok\n" if (-e _ and -f _ and -r _); |
233 | EXPECT |
234 | ok |
235 | ######## |
236 | sub thing { 0 || return qw(now is the time) } |
237 | print thing(), "\n"; |
238 | EXPECT |
239 | nowisthetime |
240 | ######## |
241 | $ren = 'joy'; |
242 | $stimpy = 'happy'; |
243 | { local $main::{ren} = *stimpy; print $ren, ' ' } |
244 | print $ren, "\n"; |
245 | EXPECT |
246 | happy joy |
247 | ######## |
248 | $stimpy = 'happy'; |
249 | { local $main::{ren} = *stimpy; print ${'ren'}, ' ' } |
250 | print +(defined(${'ren'}) ? 'oops' : 'joy'), "\n"; |
251 | EXPECT |
252 | happy joy |
253 | ######## |
254 | package p; |
255 | sub func { print 'really ' unless wantarray; 'p' } |
256 | sub groovy { 'groovy' } |
257 | package main; |
258 | print p::func()->groovy(), "\n" |
259 | EXPECT |
260 | really groovy |
261 | ######## |
44a8e56a |
262 | ($k, $s) = qw(x 0); |
263 | @{$h{$k}} = qw(1 2 4); |
264 | for (@{$h{$k}}) { $s += $_; delete $h{$k} if ($_ == 2) } |
265 | print "bogus\n" unless $s == 7; |
266 | ######## |
267 | my $a = 'outer'; |
268 | eval q[ my $a = 'inner'; eval q[ print "$a " ] ]; |
269 | eval { my $x = 'peace'; eval q[ print "$x\n" ] } |
270 | EXPECT |
271 | inner peace |