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