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