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