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