2 # Tests that all ops can be trapped by a Safe compartment
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;
12 if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
13 print "1..0\n"; exit 0;
21 # Read the op names and descriptions directly from opcode.pl
27 die "Can't match $_" unless /^([a-z_0-9]+)\t+(.*)/;
31 open my $fh, '<', '../../opcode.pl' or die "Can't open opcode.pl: $!";
38 my ($op, $opname) = split /\t+/;
39 push @op, [$op, $opname, $code{$op}];
43 plan(tests => scalar @op);
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;
52 like($@, qr/'\Q$opname\E' trapped by operation mask/, $op);
59 local $TODO = "No test yet for $_->[1]";
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)
75 gvsv SKIP (set by optimizer) $x
81 padany SKIP (not implemented)
82 pushre SKIP split /foo/
88 prototype prototype 'foo'
96 rcatline SKIP (set by optimizer) $x .= <F>
97 regcmaybe SKIP (internal)
98 regcreset SKIP (internal)
99 regcomp SKIP (internal)
103 substcont SKIP (set by optimizer)
116 i_preinc SKIP (set by optimizer)
118 i_predec SKIP (set by optimizer)
120 i_postinc SKIP (set by optimizer)
122 i_postdec SKIP (set by optimizer)
125 i_multiply SKIP (set by optimizer)
127 i_divide SKIP (set by optimizer)
129 i_modulo SKIP (set by optimizer)
132 i_add SKIP (set by optimizer)
134 i_subtract SKIP (set by optimizer)
140 i_lt SKIP (set by optimizer)
142 i_gt SKIP (set by optimizer)
144 i_le SKIP (set by optimizer)
146 i_ge SKIP (set by optimizer)
148 i_eq SKIP (set by optimizer)
150 i_ne SKIP (set by optimizer)
152 i_ncmp SKIP (set by optimizer)
164 i_negate SKIP (set by optimizer)
184 sprintf sprintf '%s', 'foo'
188 crypt crypt 'foo','bar'
195 aelemfast SKIP (set by optimizer)
201 delete delete $h{Key}
202 exists exists $h{Key}
214 splice splice @x, 1, 2, 3
221 grepstart grep { $_ eq 'foo' } @x
222 grepwhile SKIP grep { $_ eq 'foo' } @x
223 mapstart map $_ + 1, @foo
224 mapwhile SKIP (set by optimizer)
237 leavesublv sub f:lvalue{return $x} f()
244 dbstate SKIP (needs debugger)
264 umask umask 0755, 'foo'
271 sselect SKIP (set by optimizer)
287 seek seek FH, $pos, $whence
288 truncate truncate FOO, 42
301 getsockname getsockname
302 getpeername getpeername
336 chmod chmod 511, 'foo'
338 rename rename 'foo', 'bar'
339 link link 'foo', 'bar'
340 symlink symlink 'foo', 'bar'
341 readlink readlink 'foo'
347 seekdir seekdir DIR, $pos
348 rewinddir rewinddir DIR
349 closedir closedir DIR
359 getpriority getpriority
360 setpriority setpriority
382 entertry SKIP eval { 1+1 }
383 leavetry SKIP eval { 1+1 }
384 ghbyname gethostbyname 'foo'
385 ghbyaddr gethostbyaddr 'foo'
387 gnbyname getnetbyname 'foo'
388 gnbyaddr getnetbyaddr 'foo'
390 gpbyname getprotobyname 'foo'
391 gpbynumber getprotobynumber 42
392 gprotoent getprotoent
393 gsbyname getservbyname 'name', 'proto'
394 gsbyport getservbyport 'a', 'b'
398 sprotoent setprotoent
402 eprotoent endprotoent
422 once SKIP {use feature 'state'; state $foo = 42;}
423 say SKIP {use feature 'say'; say "foo";}
427 avalues SKIP values @t