Commit | Line | Data |
317982ac |
1 | #!./perl |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
20822f61 |
5 | @INC = '../lib'; |
317982ac |
6 | } |
7 | |
0ecd3ba2 |
8 | $| = 1; |
317982ac |
9 | umask 0; |
10 | $xref = \ ""; |
16ed4686 |
11 | $runme = $^X; |
317982ac |
12 | @a = (1..5); |
13 | %h = (1..6); |
14 | $aref = \@a; |
15 | $href = \%h; |
562a7b0c |
16 | open OP, qq{$runme -le "print 'aaa Ok ok' for 1..100"|}; |
317982ac |
17 | $chopit = 'aaaaaa'; |
18 | @chopar = (113 .. 119); |
19 | $posstr = '123456'; |
20 | $cstr = 'aBcD.eF'; |
21 | pos $posstr = 3; |
22 | $nn = $n = 2; |
23 | sub subb {"in s"} |
24 | |
25 | @INPUT = <DATA>; |
3dbf192b |
26 | @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT; |
fdc5b023 |
27 | print "1..", (11 + @INPUT + @simple_input), "\n"; |
317982ac |
28 | $ord = 0; |
29 | |
30 | sub wrn {"@_"} |
31 | |
ed7ab888 |
32 | # Check correct optimization of ucfirst etc |
33 | $ord++; |
34 | my $a = "AB"; |
35 | my $b = "\u\L$a"; |
36 | print "not " unless $b eq 'Ab'; |
37 | print "ok $ord\n"; |
38 | |
39 | # Check correct destruction of objects: |
40 | my $dc = 0; |
41 | sub A::DESTROY {$dc += 1} |
42 | $a=8; |
43 | my $b; |
44 | { my $c = 6; $b = bless \$c, "A"} |
45 | |
46 | $ord++; |
47 | print "not " unless $dc == 0; |
48 | print "ok $ord\n"; |
49 | |
50 | $b = $a+5; |
51 | |
52 | $ord++; |
53 | print "not " unless $dc == 1; |
54 | print "ok $ord\n"; |
55 | |
69b47968 |
56 | $ord++; |
57 | my $xxx = 'b'; |
58 | $xxx = 'c' . ($xxx || 'e'); |
59 | print "not " unless $xxx eq 'cb'; |
60 | print "ok $ord\n"; |
61 | |
ed7ab888 |
62 | { # Check calling STORE |
63 | my $sc = 0; |
64 | sub B::TIESCALAR {bless [11], 'B'} |
65 | sub B::FETCH { -(shift->[0]) } |
66 | sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift } |
67 | |
68 | my $m; |
69 | tie $m, 'B'; |
70 | $m = 100; |
71 | |
72 | $ord++; |
73 | print "not " unless $sc == 1; |
74 | print "ok $ord\n"; |
75 | |
76 | my $t = 11; |
77 | $m = $t + 89; |
78 | |
79 | $ord++; |
80 | print "not " unless $sc == 2; |
81 | print "ok $ord\n"; |
82 | |
83 | $ord++; |
84 | print "# $m\nnot " unless $m == -117; |
85 | print "ok $ord\n"; |
86 | |
87 | $m += $t; |
88 | |
89 | $ord++; |
90 | print "not " unless $sc == 3; |
91 | print "ok $ord\n"; |
92 | |
93 | $ord++; |
94 | print "# $m\nnot " unless $m == 89; |
95 | print "ok $ord\n"; |
96 | |
97 | } |
98 | |
6b66af17 |
99 | # Chains of assignments |
100 | |
101 | my ($l1, $l2, $l3, $l4); |
102 | my $zzzz = 12; |
103 | $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 1 + $zzzz; |
104 | |
105 | $ord++; |
106 | print "# $zzz1 = $l1 = $l2 = $zzz2 = $l3 = $l4 = 13\nnot " |
107 | unless $zzz1 == 13 and $zzz2 == 13 and $l1 == 13 |
108 | and $l2 == 13 and $l3 == 13 and $l4 == 13; |
109 | print "ok $ord\n"; |
110 | |
317982ac |
111 | for (@INPUT) { |
112 | $ord++; |
113 | ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/; |
114 | $comment = $op unless defined $comment; |
ee8c7f54 |
115 | chomp; |
317982ac |
116 | $op = "$op==$op" unless $op =~ /==/; |
117 | ($op, $expectop) = $op =~ /(.*)==(.*)/; |
118 | |
0f4592ef |
119 | $skip = ($op =~ /^'\?\?\?'/ or $comment =~ /skip\(.*\Q$^O\E.*\)/i) |
ee8c7f54 |
120 | ? "skip" : "# '$_'\nnot"; |
317982ac |
121 | $integer = ($comment =~ /^i_/) ? "use integer" : '' ; |
122 | (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip'; |
123 | |
124 | eval <<EOE; |
125 | local \$SIG{__WARN__} = \\&wrn; |
126 | my \$a = 'fake'; |
127 | $integer; |
128 | \$a = $op; |
129 | \$b = $expectop; |
130 | if (\$a ne \$b) { |
131 | print "# \$comment: got `\$a', expected `\$b'\n"; |
132 | print "\$skip " if \$a ne \$b or \$skip eq 'skip'; |
133 | } |
134 | print "ok \$ord\\n"; |
135 | EOE |
136 | if ($@) { |
137 | if ($@ =~ /is unimplemented/) { |
138 | print "# skipping $comment: unimplemented:\nok $ord\n"; |
139 | } else { |
140 | warn $@; |
ee8c7f54 |
141 | print "# '$_'\nnot ok $ord\n"; |
317982ac |
142 | } |
143 | } |
144 | } |
3dbf192b |
145 | |
146 | for (@simple_input) { |
147 | $ord++; |
148 | ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/; |
149 | $comment = $op unless defined $comment; |
ee8c7f54 |
150 | chomp; |
3dbf192b |
151 | ($operator, $variable) = /^\s*(\w+)\s*\$(\w+)/ or warn "misprocessed '$_'\n"; |
152 | eval <<EOE; |
153 | local \$SIG{__WARN__} = \\&wrn; |
154 | my \$$variable = "Ac# Ca\\nxxx"; |
155 | \$$variable = $operator \$$variable; |
156 | \$toself = \$$variable; |
157 | \$direct = $operator "Ac# Ca\\nxxx"; |
158 | print "# \\\$$variable = $operator \\\$$variable\\nnot " |
159 | unless \$toself eq \$direct; |
160 | print "ok \$ord\\n"; |
161 | EOE |
162 | if ($@) { |
163 | if ($@ =~ /is unimplemented/) { |
164 | print "# skipping $comment: unimplemented:\nok $ord\n"; |
165 | } elsif ($@ =~ /Can't (modify|take log of 0)/) { |
166 | print "# skipping $comment: syntax not good for selfassign:\nok $ord\n"; |
167 | } else { |
168 | warn $@; |
ee8c7f54 |
169 | print "# '$_'\nnot ok $ord\n"; |
3dbf192b |
170 | } |
171 | } |
172 | } |
fdc5b023 |
173 | |
174 | $ord++; |
175 | eval { |
176 | sub PVBM () { 'foo' } |
177 | index 'foo', PVBM; |
178 | my $x = PVBM; |
179 | |
180 | my $str = 'foo'; |
181 | my $pvlv = \substr $str, 0, 1; |
182 | $x = $pvlv; |
183 | |
184 | 1; |
185 | }; |
186 | if ($@) { |
187 | warn "# $@"; |
188 | print 'not '; |
189 | } |
190 | print "ok $ord\n"; |
191 | |
317982ac |
192 | __END__ |
193 | ref $xref # ref |
194 | ref $cstr # ref nonref |
75f2fcd2 |
195 | `$runme -e "print qq[1\\n]"` # backtick skip(MSWin32) |
0f4592ef |
196 | `$undefed` # backtick undef skip(MSWin32) |
317982ac |
197 | <*> # glob |
198 | <OP> # readline |
199 | 'faked' # rcatline |
200 | (@z = (1 .. 3)) # aassign |
201 | chop $chopit # chop |
202 | (chop (@x=@chopar)) # schop |
203 | chomp $chopit # chomp |
204 | (chop (@x=@chopar)) # schomp |
205 | pos $posstr # pos |
206 | pos $chopit # pos returns undef |
207 | $nn++==2 # postinc |
208 | $nn++==3 # i_postinc |
209 | $nn--==4 # postdec |
210 | $nn--==3 # i_postdec |
211 | $n ** $n # pow |
212 | $n * $n # multiply |
213 | $n * $n # i_multiply |
214 | $n / $n # divide |
215 | $n / $n # i_divide |
216 | $n % $n # modulo |
217 | $n % $n # i_modulo |
218 | $n x $n # repeat |
219 | $n + $n # add |
220 | $n + $n # i_add |
221 | $n - $n # subtract |
222 | $n - $n # i_subtract |
223 | $n . $n # concat |
224 | $n . $a=='2fake' # concat with self |
225 | "3$a"=='3fake' # concat with self in stringify |
226 | "$n" # stringify |
227 | $n << $n # left_shift |
228 | $n >> $n # right_shift |
229 | $n <=> $n # ncmp |
230 | $n <=> $n # i_ncmp |
231 | $n cmp $n # scmp |
232 | $n & $n # bit_and |
233 | $n ^ $n # bit_xor |
234 | $n | $n # bit_or |
235 | -$n # negate |
236 | -$n # i_negate |
237 | ~$n # complement |
238 | atan2 $n,$n # atan2 |
239 | sin $n # sin |
240 | cos $n # cos |
241 | '???' # rand |
242 | exp $n # exp |
243 | log $n # log |
244 | sqrt $n # sqrt |
245 | int $n # int |
246 | hex $n # hex |
247 | oct $n # oct |
248 | abs $n # abs |
249 | length $posstr # length |
250 | substr $posstr, 2, 2 # substr |
251 | vec("abc",2,8) # vec |
252 | index $posstr, 2 # index |
253 | rindex $posstr, 2 # rindex |
254 | sprintf "%i%i", $n, $n # sprintf |
255 | ord $n # ord |
256 | chr $n # chr |
257 | crypt $n, $n # crypt |
258 | ucfirst ($cstr . "a") # ucfirst padtmp |
259 | ucfirst $cstr # ucfirst |
260 | lcfirst $cstr # lcfirst |
261 | uc $cstr # uc |
262 | lc $cstr # lc |
263 | quotemeta $cstr # quotemeta |
264 | @$aref # rv2av |
265 | @$undefed # rv2av undef |
3918450e |
266 | (each %h) % 2 == 1 # each |
317982ac |
267 | values %h # values |
268 | keys %h # keys |
269 | %$href # rv2hv |
270 | pack "C2", $n,$n # pack |
271 | split /a/, "abad" # split |
272 | join "a"; @a # join |
273 | push @a,3==6 # push |
274 | unshift @aaa # unshift |
275 | reverse @a # reverse |
276 | reverse $cstr # reverse - scal |
277 | grep $_, 1,0,2,0,3 # grepwhile |
278 | map "x$_", 1,0,2,0,3 # mapwhile |
279 | subb() # entersub |
280 | caller # caller |
281 | warn "ignore this\n" # warn |
282 | 'faked' # die |
283 | open BLAH, "<non-existent" # open |
284 | fileno STDERR # fileno |
285 | umask 0 # umask |
286 | select STDOUT # sselect |
ff97eb1b |
287 | select undef,undef,undef,0 # select |
317982ac |
288 | getc OP # getc |
289 | '???' # read |
290 | '???' # sysread |
291 | '???' # syswrite |
292 | '???' # send |
293 | '???' # recv |
294 | '???' # tell |
295 | '???' # fcntl |
296 | '???' # ioctl |
297 | '???' # flock |
298 | '???' # accept |
299 | '???' # shutdown |
300 | '???' # ftsize |
301 | '???' # ftmtime |
302 | '???' # ftatime |
303 | '???' # ftctime |
304 | chdir 'non-existent' # chdir |
305 | '???' # chown |
306 | '???' # chroot |
307 | unlink 'non-existent' # unlink |
308 | chmod 'non-existent' # chmod |
309 | utime 'non-existent' # utime |
310 | rename 'non-existent', 'non-existent1' # rename |
311 | link 'non-existent', 'non-existent1' # link |
ecece5d6 |
312 | '???' # symlink |
317982ac |
313 | readlink 'non-existent', 'non-existent1' # readlink |
314 | '???' # mkdir |
315 | '???' # rmdir |
316 | '???' # telldir |
317 | '???' # fork |
318 | '???' # wait |
319 | '???' # waitpid |
562a7b0c |
320 | system "$runme -e 0" # system skip(VMS) |
317982ac |
321 | '???' # exec |
0f4592ef |
322 | '???' # kill |
317982ac |
323 | getppid # getppid |
324 | getpgrp # getpgrp |
325 | '???' # setpgrp |
326 | getpriority $$, $$ # getpriority |
327 | '???' # setpriority |
328 | time # time |
7e3cfbc1 |
329 | localtime $^T # localtime |
330 | gmtime $^T # gmtime |
dbb6c582 |
331 | '???' # sleep: can randomly fail |
317982ac |
332 | '???' # alarm |
333 | '???' # shmget |
334 | '???' # shmctl |
335 | '???' # shmread |
336 | '???' # shmwrite |
337 | '???' # msgget |
338 | '???' # msgctl |
339 | '???' # msgsnd |
340 | '???' # msgrcv |
341 | '???' # semget |
342 | '???' # semctl |
343 | '???' # semop |
344 | '???' # getlogin |
345 | '???' # syscall |