t/codingstd/opcode_doc.t

   1 #! perl
   2 # Copyright (C) 2001-2010, Parrot Foundation.
   3 # $Id$
   4
   5 use strict;
   6 use warnings;
   7 use lib qw( . lib ../lib ../../lib );
   8 use Test::More tests => 1;
   9
  10 =head1 NAME
  11
  12 t/perl/opcode_doc.t - check opcode documentation
  13
  14 =head1 SYNOPSIS
  15
  16     % prove t/perl/opcode_doc.t
  17
  18 =head1 DESCRIPTION
  19
  20 Checks whether all opcodes are documented.
  21
  22 =cut
  23
  24 my @docerr;
  25
  26 sub slurp {
  27     my ($filename) = @_;
  28
  29     open my $FILE, '<', "$filename" or die "can't open '$filename' for reading";
  30     my @file = <$FILE>;
  31     close $FILE;
  32     return @file;
  33 }
  34
  35 sub analyse {
  36     my ( $filename, $ops ) = @_;
  37
  38     my %file;
  39
  40     foreach my $op ( keys %$ops ) {
  41         my $args = $ops->{$op};
  42         next if $op =~ /^DELETED/;
  43         next if $op =~ /^isgt/;      # doced but rewritten
  44         next if $op =~ /^isge/;
  45         foreach my $arg ( keys %$args ) {
  46             my $e   = $args->{$arg};
  47             my $val = $e->{status};
  48             next if $val == 3;       # doc & impl
  49             $file{ $e->{def} } = "no documentation for $op($arg)" if exists $e->{def};
  50             $file{ $e->{doc} } = "no definition of $op($arg)"     if exists $e->{doc};
  51         }
  52     }
  53
  54     foreach my $line ( sort { $a <=> $b } keys %file ) {
  55         push @docerr, "$filename:$line: $file{$line}\n";
  56     }
  57 }
  58
  59 sub check_op_doc {
  60     my ($filename) = @_;
  61
  62     my @file = slurp($filename);
  63     my %op;
  64     my $lineno = 0;
  65
  66     foreach my $line (@file) {
  67         ++$lineno;
  68         if ( my ($item) = $line =~ /^=item\s+(.+\(.*)/ ) {
  69             if ( $item =~ /^([BC])\<(.*)\>\s*\((.*?)\)/ ) {
  70                 print "$filename:$lineno: use B<...> instead of C<...>\n"
  71                     if $1 eq "C";
  72                 my ( $op, $args ) = ( $2, $3 );
  73                 $args =~ s!\s*/\*.*?\*/!!;    # del C comment in args
  74                 $op{$op}{$args}{doc} = $lineno;
  75                 $op{$op}{$args}{status} |= 1;
  76             }
  77         }
  78         elsif ( $line =~ /^(inline )?\s*op\s*(\S+)\s*\((.*?)\)/ ) {
  79             $op{$2}{$3}{def} = $lineno;
  80             $op{$2}{$3}{status} |= 2;
  81         }
  82     }
  83     analyse( $filename, \%op );
  84 }
  85
  86 foreach my $file (<src/ops/*.ops>) {
  87     check_op_doc $file;
  88 }
  89
  90 ok( !@docerr, 'opcode documentation' ) or diag("Opcode documentation errors:\n@docerr");
  91
  92 # Local Variables:
  93 #   mode: cperl
  94 #   cperl-indent-level: 4
  95 #   fill-column: 100
  96 # End:
  97 # vim: expandtab shiftwidth=4: