Move Pod::Plainer from ext/ to dist/
[perl.git] / ext / Safe / t / safeops.t
1 #!perl
2 # Tests that all ops can be trapped by a Safe compartment
3
4 BEGIN {
5     unless ($ENV{PERL_CORE}) {
6         # this won't work outside of the core, so exit
7         print "1..0 # skipped: PERL_CORE unset\n"; exit 0;
8     }
9 }
10 use Config;
11 BEGIN {
12     if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
13         print "1..0\n"; exit 0;
14     }
15 }
16
17 use strict;
18 use Test::More;
19 use Safe;
20
21 # Read the op names and descriptions directly from opcode.pl
22 my @op;
23 my %code;
24
25 while (<DATA>) {
26     chomp;
27     die "Can't match $_" unless /^([a-z_0-9]+)\t+(.*)/;
28     $code{$1} = $2;
29 }
30
31 open my $fh, '<', '../../opcode.pl' or die "Can't open opcode.pl: $!";
32 while (<$fh>) {
33     last if /^__END__/;
34 }
35 while (<$fh>) {
36     chomp;
37     next if !$_ or /^#/;
38     my ($op, $opname) = split /\t+/;
39     push @op, [$op, $opname, $code{$op}];
40 }
41 close $fh;
42
43 plan(tests => scalar @op);
44
45 sub testop {
46     my ($op, $opname, $code) = @_;
47     pass("$op : skipped") and return if $code =~ /^SKIP/;
48     pass("$op : skipped") and return if $code =~ m://|~~: && $] < 5.010;
49     my $c = new Safe;
50     $c->deny_only($op);
51     $c->reval($code);
52     like($@, qr/'\Q$opname\E' trapped by operation mask/, $op);
53 }
54
55 foreach (@op) {
56     if ($_->[2]) {
57         testop @$_;
58     } else {
59         local $TODO = "No test yet for $_->[1]";
60         fail();
61     }
62 }
63
64 # things that begin with SKIP are skipped, for various reasons (notably
65 # optree modified by the optimizer -- Safe checks are done before the
66 # optimizer modifies the optree)
67
68 __DATA__
69 null            SKIP
70 stub            SKIP
71 scalar          scalar $x
72 pushmark        print @x
73 wantarray       wantarray
74 const           42
75 gvsv            SKIP (set by optimizer) $x
76 gv              SKIP *x
77 gelem           *x{SCALAR}
78 padsv           SKIP my $x
79 padav           SKIP my @x
80 padhv           SKIP my %x
81 padany          SKIP (not implemented)
82 pushre          SKIP split /foo/
83 rv2gv           *x
84 rv2sv           $x
85 av2arylen       $#x
86 rv2cv           f()
87 anoncode        sub { }
88 prototype       prototype 'foo'
89 refgen          \($x,$y)
90 srefgen         SKIP \$x
91 ref             ref
92 bless           bless
93 backtick        qx/ls/
94 glob            <*.c>
95 readline        <FH>
96 rcatline        SKIP (set by optimizer) $x .= <F>
97 regcmaybe       SKIP (internal)
98 regcreset       SKIP (internal)
99 regcomp         SKIP (internal)
100 match           /foo/
101 qr              qr/foo/
102 subst           s/foo/bar/
103 substcont       SKIP (set by optimizer)
104 trans           y:z:t:
105 sassign         $x = $y
106 aassign         @x = @y
107 chop            chop @foo
108 schop           chop
109 chomp           chomp @foo
110 schomp          chomp
111 defined         defined
112 undef           undef
113 study           study
114 pos             pos
115 preinc          ++$i
116 i_preinc        SKIP (set by optimizer)
117 predec          --$i
118 i_predec        SKIP (set by optimizer)
119 postinc         $i++
120 i_postinc       SKIP (set by optimizer)
121 postdec         $i--
122 i_postdec       SKIP (set by optimizer)
123 pow             $x ** $y
124 multiply        $x * $y
125 i_multiply      SKIP (set by optimizer)
126 divide          $x / $y
127 i_divide        SKIP (set by optimizer)
128 modulo          $x % $y
129 i_modulo        SKIP (set by optimizer)
130 repeat          $x x $y
131 add             $x + $y
132 i_add           SKIP (set by optimizer)
133 subtract        $x - $y
134 i_subtract      SKIP (set by optimizer)
135 concat          $x . $y
136 stringify       "$x"
137 left_shift      $x << 1
138 right_shift     $x >> 1
139 lt              $x < $y
140 i_lt            SKIP (set by optimizer)
141 gt              $x > $y
142 i_gt            SKIP (set by optimizer)
143 le              $i <= $y
144 i_le            SKIP (set by optimizer)
145 ge              $i >= $y
146 i_ge            SKIP (set by optimizer)
147 eq              $x == $y
148 i_eq            SKIP (set by optimizer)
149 ne              $x != $y
150 i_ne            SKIP (set by optimizer)
151 ncmp            $i <=> $y
152 i_ncmp          SKIP (set by optimizer)
153 slt             $x lt $y
154 sgt             $x gt $y
155 sle             $x le $y
156 sge             $x ge $y
157 seq             $x eq $y
158 sne             $x ne $y
159 scmp            $x cmp $y
160 bit_and         $x & $y
161 bit_xor         $x ^ $y
162 bit_or          $x | $y
163 negate          -$x
164 i_negate        SKIP (set by optimizer)
165 not             !$x
166 complement      ~$x
167 atan2           atan2 1
168 sin             sin 1
169 cos             cos 1
170 rand            rand
171 srand           srand
172 exp             exp 1
173 log             log 1
174 sqrt            sqrt 1
175 int             int
176 hex             hex
177 oct             oct
178 abs             abs
179 length          length
180 substr          substr $x, 1
181 vec             vec
182 index           index
183 rindex          rindex
184 sprintf         sprintf '%s', 'foo'
185 formline        formline
186 ord             ord
187 chr             chr
188 crypt           crypt 'foo','bar'
189 ucfirst         ucfirst
190 lcfirst         lcfirst
191 uc              uc
192 lc              lc
193 quotemeta       quotemeta
194 rv2av           @a
195 aelemfast       SKIP (set by optimizer)
196 aelem           $a[1]
197 aslice          @a[1,2]
198 each            each %h
199 values          values %h
200 keys            keys %h
201 delete          delete $h{Key}
202 exists          exists $h{Key}
203 rv2hv           %h
204 helem           $h{kEy}
205 hslice          @h{kEy}
206 unpack          unpack
207 pack            pack
208 split           split /foo/
209 join            join $a, @b
210 list            @x = (1,2)
211 lslice          SKIP @x[1,2]
212 anonlist        [1,2]
213 anonhash        { a => 1 }
214 splice          splice @x, 1, 2, 3
215 push            push @x, $x
216 pop             pop @x
217 shift           shift @x
218 unshift         unshift @x
219 sort            sort @x
220 reverse         reverse @x
221 grepstart       grep { $_ eq 'foo' } @x
222 grepwhile       SKIP grep { $_ eq 'foo' } @x
223 mapstart        map $_ + 1, @foo
224 mapwhile        SKIP (set by optimizer)
225 range           SKIP
226 flip            1..2
227 flop            1..2
228 and             $x && $y
229 or              $x || $y
230 xor             $x xor $y
231 cond_expr       $x ? 1 : 0
232 andassign       $x &&= $y
233 orassign        $x ||= $y
234 method          Foo->$x()
235 entersub        f()
236 leavesub        sub f{} f()
237 leavesublv      sub f:lvalue{return $x} f()
238 caller          caller
239 warn            warn
240 die             die
241 reset           reset
242 lineseq         SKIP
243 nextstate       SKIP
244 dbstate         SKIP (needs debugger)
245 unstack         while(0){}
246 enter           SKIP
247 leave           SKIP
248 scope           SKIP
249 enteriter       SKIP
250 iter            SKIP
251 enterloop       SKIP
252 leaveloop       SKIP
253 return          return
254 last            last
255 next            next
256 redo            redo THIS
257 dump            dump
258 goto            goto THERE
259 exit            exit 0
260 open            open FOO
261 close           close FOO
262 pipe_op         pipe FOO,BAR
263 fileno          fileno FOO
264 umask           umask 0755, 'foo'
265 binmode         binmode FOO
266 tie             tie
267 untie           untie
268 tied            tied
269 dbmopen         dbmopen
270 dbmclose        dbmclose
271 sselect         SKIP (set by optimizer)
272 select          select FOO
273 getc            getc FOO
274 read            read FOO
275 enterwrite      write
276 leavewrite      SKIP
277 prtf            printf
278 print           print
279 sysopen         sysopen
280 sysseek         sysseek
281 sysread         sysread
282 syswrite        syswrite
283 send            send
284 recv            recv
285 eof             eof FOO
286 tell            tell
287 seek            seek FH, $pos, $whence
288 truncate        truncate FOO, 42
289 fcntl           fcntl
290 ioctl           ioctl
291 flock           flock FOO, 1
292 socket          socket
293 sockpair        socketpair
294 bind            bind
295 connect         connect
296 listen          listen
297 accept          accept
298 shutdown        shutdown
299 gsockopt        getsockopt
300 ssockopt        setsockopt
301 getsockname     getsockname
302 getpeername     getpeername
303 lstat           lstat FOO
304 stat            stat FOO
305 ftrread         -R
306 ftrwrite        -W
307 ftrexec         -X
308 fteread         -r
309 ftewrite        -w
310 fteexec         -x
311 ftis            -e
312 fteowned        SKIP -O
313 ftrowned        SKIP -o
314 ftzero          -z
315 ftsize          -s
316 ftmtime         -M
317 ftatime         -A
318 ftctime         -C
319 ftsock          -S
320 ftchr           -c
321 ftblk           -b
322 ftfile          -f
323 ftdir           -d
324 ftpipe          -p
325 ftlink          -l
326 ftsuid          -u
327 ftsgid          -g
328 ftsvtx          -k
329 fttty           -t
330 fttext          -T
331 ftbinary        -B
332 chdir           chdir '/'
333 chown           chown
334 chroot          chroot
335 unlink          unlink 'foo'
336 chmod           chmod 511, 'foo'
337 utime           utime
338 rename          rename 'foo', 'bar'
339 link            link 'foo', 'bar'
340 symlink         symlink 'foo', 'bar'
341 readlink        readlink 'foo'
342 mkdir           mkdir 'foo'
343 rmdir           rmdir 'foo'
344 open_dir        opendir DIR
345 readdir         readdir DIR
346 telldir         telldir DIR
347 seekdir         seekdir DIR, $pos
348 rewinddir       rewinddir DIR
349 closedir        closedir DIR
350 fork            fork
351 wait            wait
352 waitpid         waitpid
353 system          system
354 exec            exec
355 kill            kill
356 getppid         getppid
357 getpgrp         getpgrp
358 setpgrp         setpgrp
359 getpriority     getpriority
360 setpriority     setpriority
361 time            time
362 tms             times
363 localtime       localtime
364 gmtime          gmtime
365 alarm           alarm
366 sleep           sleep 1
367 shmget          shmget
368 shmctl          shmctl
369 shmread         shmread
370 shmwrite        shmwrite
371 msgget          msgget
372 msgctl          msgctl
373 msgsnd          msgsnd
374 msgrcv          msgrcv
375 semget          semget
376 semctl          semctl
377 semop           semop
378 require         use strict
379 dofile          do 'file'
380 entereval       eval "1+1"
381 leaveeval       eval "1+1"
382 entertry        SKIP eval { 1+1 }
383 leavetry        SKIP eval { 1+1 }
384 ghbyname        gethostbyname 'foo'
385 ghbyaddr        gethostbyaddr 'foo'
386 ghostent        gethostent
387 gnbyname        getnetbyname 'foo'
388 gnbyaddr        getnetbyaddr 'foo'
389 gnetent         getnetent
390 gpbyname        getprotobyname 'foo'
391 gpbynumber      getprotobynumber 42
392 gprotoent       getprotoent
393 gsbyname        getservbyname 'name', 'proto'
394 gsbyport        getservbyport 'a', 'b'
395 gservent        getservent
396 shostent        sethostent
397 snetent         setnetent
398 sprotoent       setprotoent
399 sservent        setservent
400 ehostent        endhostent
401 enetent         endnetent
402 eprotoent       endprotoent
403 eservent        endservent
404 gpwnam          getpwnam
405 gpwuid          getpwuid
406 gpwent          getpwent
407 spwent          setpwent
408 epwent          endpwent
409 ggrnam          getgrnam
410 ggrgid          getgrgid
411 ggrent          getgrent
412 sgrent          setgrent
413 egrent          endgrent
414 getlogin        getlogin
415 syscall         syscall
416 lock            SKIP
417 threadsv        SKIP
418 setstate        SKIP
419 method_named    $x->y()
420 dor             $x // $y
421 dorassign       $x //= $y
422 once            SKIP {use feature 'state'; state $foo = 42;}
423 say             SKIP {use feature 'say'; say "foo";}
424 smartmatch      $x ~~ $y
425 aeach           SKIP each @t
426 akeys           SKIP keys @t
427 avalues         SKIP values @t
428 custom          SKIP (no way)