From: Rafael Garcia-Suarez Date: Mon, 11 Aug 2003 19:59:17 +0000 (+0000) Subject: Add a new regression test for Safe : tests that all ops X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6c52f3eb45c9b0bdbcd8209f58fd8ec7fbae4aa8;p=p5sagit%2Fp5-mst-13.2.git Add a new regression test for Safe : tests that all ops can be trapped by a Safe compartement (except for the ones that can't.) p4raw-id: //depot/perl@20623 --- diff --git a/MANIFEST b/MANIFEST index 0fc4582..35c3d67 100644 --- a/MANIFEST +++ b/MANIFEST @@ -601,6 +601,7 @@ ext/re/t/re.t see if re pragma works ext/Safe/t/safe1.t See if Safe works ext/Safe/t/safe2.t See if Safe works ext/Safe/t/safe3.t See if Safe works +ext/Safe/t/safeops.t Tests that all ops can be trapped by Safe ext/SDBM_File/Makefile.PL SDBM extension makefile writer ext/SDBM_File/sdbm/biblio SDBM kit ext/SDBM_File/sdbm/CHANGES SDBM kit diff --git a/ext/Safe/t/safeops.t b/ext/Safe/t/safeops.t new file mode 100644 index 0000000..285e978 --- /dev/null +++ b/ext/Safe/t/safeops.t @@ -0,0 +1,415 @@ +#!perl +# Tests that all ops can be trapped by a Safe compartment + +BEGIN { + if ($ENV{PERL_CORE}) { + chdir 't' if -d 't'; + @INC = '../lib'; + } + else { + # this won't work outside of the core, so exit + print "1..0\n"; exit 0; + } +} +use Config; +BEGIN { + if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') { + print "1..0\n"; exit 0; + } +} + +use strict; +use Test::More tests => 354; +use Safe; + +# Read the op names and descriptions directly from opcode.pl +my @op; +my @opname; +open my $fh, '<', '../opcode.pl' or die "Can't open opcode.pl: $!"; +while (<$fh>) { + last if /^__END__/; +} +while (<$fh>) { + chomp; + next if !$_ or /^#/; + my ($op, $opname) = split /\t+/; + push @op, $op; + push @opname, $opname; +} +close $fh; + +sub testop { + my ($op, $opname, $code) = @_; + pass("$op : skipped") and return if $code =~ /^SKIP/; + my $c = new Safe; + $c->deny_only($op); + $c->reval($code); + like($@, qr/'\Q$opname\E' trapped by operation mask/, $op); +} + +my $i = 0; +while () { + testop $op[$i], $opname[$i], $_; + ++$i; +} + +# lists op examples, in the same order than opcode.pl +# things that begin with SKIP are skipped, for various reasons (notably +# optree modified by the optimizer -- Safe checks are done before the +# optimizer modifies the optree) + +__DATA__ +SKIP # null +SKIP # stub +scalar $x # scalar +print @x # pushmark +wantarray # wantarray +42 # const +SKIP (set by optimizer) $x # gvsv +SKIP *x # gv +*x{SCALAR} # gelem +SKIP my $x # padsv +SKIP my @x # padav +SKIP my %x # padhv +SKIP (not implemented) # padany +SKIP split /foo/ # pushre +*x # rv2gv +$x # rv2sv +$#x # av2arylen +f() # rv2cv +sub { } # anoncode +prototype 'foo' # prototype +\($x,$y) # refgen +SKIP \$x # srefgen +ref # ref +bless # bless +qx/ls/ # backtick +<*.c> # glob + # readline +SKIP (set by optimizer) $x .= # rcatline +SKIP (internal) # regcmaybe +SKIP (internal) # regcreset +SKIP (internal) # regcomp +/foo/ # match +qr/foo/ # qr +s/foo/bar/ # subst +SKIP (set by optimizer) # substcont +y:z:t: # trans +$x = $y # sassign +@x = @y # aassign +chop @foo # chop +chop # schop +chomp @foo # chomp +chomp # schomp +defined # defined +undef # undef +study # study +pos # pos +++$i # preinc +SKIP (set by optimizer) # i_preinc +--$i # predec +SKIP (set by optimizer) # i_predec +$i++ # postinc +SKIP (set by optimizer) # i_postinc +$i-- # postdec +SKIP (set by optimizer) # i_postdec +$x ** $y # pow +$x * $y # multiply +SKIP (set by optimizer) # i_multiply +$x / $y # divide +SKIP (set by optimizer) # i_divide +$x % $y # modulo +SKIP (set by optimizer) # i_modulo +$x x $y # repeat +$x + $y # add +SKIP (set by optimizer) # i_add +$x - $y # subtract +SKIP (set by optimizer) # i_subtract +$x . $y # concat +"$x" # stringify +$x << 1 # left_shift +$x >> 1 # right_shift +$x < $y # lt +SKIP (set by optimizer) # i_lt +$x > $y # gt +SKIP (set by optimizer) # i_gt +$i <= $y # le +SKIP (set by optimizer) # i_le +$i >= $y # ge +SKIP (set by optimizer) # i_ge +$x == $y # eq +SKIP (set by optimizer) # i_eq +$x != $y # ne +SKIP (set by optimizer) # i_ne +$i <=> $y # ncmp +SKIP (set by optimizer) # i_ncmp +$x lt $y # slt +$x gt $y # sgt +$x le $y # sle +$x ge $y # sge +$x eq $y # seq +$x ne $y # sne +$x cmp $y # scmp +$x & $y # bit_and +$x ^ $y # bit_xor +$x | $y # bit_or +-$x # negate +SKIP (set by optimizer) # i_negate +!$x # not +~$x # complement +atan2 1 # atan2 +sin 1 # sin +cos 1 # cos +rand # rand +srand # srand +exp 1 # exp +log 1 # log +sqrt 1 # sqrt +int # int +hex # hex +oct # oct +abs # abs +length # length +substr $x, 1 # substr +vec # vec +index # index +rindex # rindex +sprintf '%s', 'foo' # sprintf +formline # formline +ord # ord +chr # chr +crypt 'foo','bar' # crypt +ucfirst # ucfirst +lcfirst # lcfirst +uc # uc +lc # lc +quotemeta # quotemeta +@a # rv2av +SKIP (set by optimizer) # aelemfast +$a[1] # aelem +@a[1,2] # aslice +each %h # each +values %h # values +keys %h # keys +delete $h{Key} # delete +exists $h{Key} # exists +%h # rv2hv +$h{kEy} # helem +@h{kEy} # hslice +unpack # unpack +pack # pack +split /foo/ # split +join $a, @b # join +@x = (1,2) # list +SKIP @x[1,2] # lslice +[1,2] # anonlist +{ a => 1 } # anonhash +splice @x, 1, 2, 3 # splice +push @x, $x # push +pop @x # pop +shift @x # shift +unshift @x # unshift +sort @x # sort +reverse @x # reverse +grep { $_ eq 'foo' } @x # grepstart +SKIP grep { $_ eq 'foo' } @x # grepwhile +map $_ + 1, @foo # mapstart +SKIP (set by optimizer) # mapwhile +SKIP # range +1..2 # flip +1..2 # flop +$x && $y # and +$x || $y # or +$x xor $y # xor +$x ? 1 : 0 # cond_expr +$x &&= $y # andassign +$x ||= $y # orassign +Foo->$x() # method +f() # entersub +sub f{} f() # leavesub +sub f:lvalue{return $x} f() # leavesublv +caller # caller +warn # warn +die # die +reset # reset +SKIP # lineseq +SKIP # nextstate +SKIP (needs debugger) # dbstate +while(0){} # unstack +SKIP # enter +SKIP # leave +SKIP # scope +SKIP # enteriter +SKIP # iter +SKIP # enterloop +SKIP # leaveloop +return # return +last # last +next # next +redo THIS # redo +dump # dump +goto THERE # goto +exit 0 # exit +open FOO # open +close FOO # close +pipe FOO,BAR # pipe_op +fileno FOO # fileno +umask 0755, 'foo' # umask +binmode FOO # binmode +tie # tie +untie # untie +tied # tied +dbmopen # dbmopen +dbmclose # dbmclose +SKIP (set by optimizer) # sselect +select FOO # select +getc FOO # getc +read FOO # read +write # enterwrite +SKIP # leavewrite +printf # prtf +print # print +sysopen # sysopen +sysseek # sysseek +sysread # sysread +syswrite # syswrite +send # send +recv # recv +eof FOO # eof +tell # tell +seek FH, $pos, $whence # seek +truncate FOO, 42 # truncate +fcntl # fcntl +ioctl # ioctl +flock FOO, 1 # flock +socket # socket +socketpair # sockpair +bind # bind +connect # connect +listen # listen +accept # accept +shutdown # shutdown +getsockopt # gsockopt +setsockopt # ssockopt +getsockname # getsockname +getpeername # getpeername +lstat FOO # lstat +stat FOO # stat +-R # ftrread +-W # ftrwrite +-X # ftrexec +-r # fteread +-w # ftewrite +-x # fteexec +-e # ftis +SKIP -O # fteowned +SKIP -o # ftrowned +-z # ftzero +-s # ftsize +-M # ftmtime +-A # ftatime +-C # ftctime +-S # ftsock +-c # ftchr +-b # ftblk +-f # ftfile +-d # ftdir +-p # ftpipe +-l # ftlink +-u # ftsuid +-g # ftsgid +-k # ftsvtx +-t # fttty +-T # fttext +-B # ftbinary +chdir '/' # chdir +chown # chown +chroot # chroot +unlink 'foo' # unlink +chmod 511, 'foo' # chmod +utime # utime +rename 'foo', 'bar' # rename +link 'foo', 'bar' # link +symlink 'foo', 'bar' # symlink +readlink 'foo' # readlink +mkdir 'foo' # mkdir +rmdir 'foo' # rmdir +opendir DIR # open_dir +readdir DIR # readdir +telldir DIR # telldir +seekdir DIR, $pos # seekdir +rewinddir DIR # rewinddir +closedir DIR # closedir +fork # fork +wait # wait +waitpid # waitpid +system # system +exec # exec +kill # kill +getppid # getppid +getpgrp # getpgrp +setpgrp # setpgrp +getpriority # getpriority +setpriority # setpriority +time # time +times # tms +localtime # localtime +gmtime # gmtime +alarm # alarm +sleep 1 # sleep +shmget # shmget +shmctl # shmctl +shmread # shmread +shmwrite # shmwrite +msgget # msgget +msgctl # msgctl +msgsnd # msgsnd +msgrcv # msgrcv +semget # semget +semctl # semctl +semop # semop +use strict # require +do 'file' # dofile +eval "1+1" # entereval +eval "1+1" # leaveeval +SKIP eval { 1+1 } # entertry +SKIP eval { 1+1 } # leavetry +gethostbyname 'foo' # ghbyname +gethostbyaddr 'foo' # ghbyaddr +gethostent # ghostent +getnetbyname 'foo' # gnbyname +getnetbyaddr 'foo' # gnbyaddr +getnetent # gnetent +getprotobyname 'foo' # gpbyname +getprotobynumber 42 # gpbynumber +getprotoent # gprotoent +getservbyname 'name', 'proto' # gsbyname +getservbyport 'a', 'b' # gsbyport +getservent # gservent +sethostent # shostent +setnetent # snetent +setprotoent # sprotoent +setservent # sservent +endhostent # ehostent +endnetent # enetent +endprotoent # eprotoent +endservent # eservent +getpwnam # gpwnam +getpwuid # gpwuid +getpwent # gpwent +setpwent # spwent +endpwent # epwent +getgrnam # ggrnam +getgrgid # ggrgid +getgrent # ggrent +setgrent # sgrent +endgrent # egrent +getlogin # getlogin +syscall # syscall +SKIP # lock +SKIP # threadsv +SKIP # setstate +$x->y() # method_named +$x // $y # dor +$x //= $y # dorassign +SKIP (no way) # custom