Skip to content
This repository
tag: RELEASE_3_7_0
Fetching contributors…

Cannot retrieve contributors at this time

file 96 lines (75 sloc) 2.355 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
#! perl
# Copyright (C) 2001-2010, Parrot Foundation.

use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More tests => 1;

=head1 NAME

t/perl/opcode_doc.t - check opcode documentation

=head1 SYNOPSIS

% prove t/perl/opcode_doc.t

=head1 DESCRIPTION

Checks whether all opcodes are documented.

=cut

my @docerr;

sub slurp {
    my ($filename) = @_;

    open my $FILE, '<', "$filename" or die "can't open '$filename' for reading";
    my @file = <$FILE>;
    close $FILE;
    return @file;
}

sub analyse {
    my ( $filename, $ops ) = @_;

    my %file;

    foreach my $op ( keys %$ops ) {
        my $args = $ops->{$op};
        next if $op =~ /^DELETED/;
        next if $op =~ /^isgt/; # doced but rewritten
        next if $op =~ /^isge/;
        foreach my $arg ( keys %$args ) {
            my $e = $args->{$arg};
            my $val = $e->{status};
            next if $val == 3; # doc & impl
            $file{ $e->{def} } = "no documentation for $op($arg)" if exists $e->{def};
            $file{ $e->{doc} } = "no definition of $op($arg)" if exists $e->{doc};
        }
    }

    foreach my $line ( sort { $a <=> $b } keys %file ) {
        push @docerr, "$filename:$line: $file{$line}\n";
    }
}

sub check_op_doc {
    my ($filename) = @_;

    my @file = slurp($filename);
    my %op;
    my $lineno = 0;

    foreach my $line (@file) {
        ++$lineno;
        if ( my ($item) = $line =~ /^=item\s+(.+\(.*)/ ) {
            if ( $item =~ /^([BC])\<(.*)\>\s*\((.*?)\)/ ) {
                print "$filename:$lineno: use B<...> instead of C<...>\n"
                    if $1 eq "C";
                my ( $op, $args ) = ( $2, $3 );
                $args =~ s!\s*/\*.*?\*/!!; # del C comment in args
                $op{$op}{$args}{doc} = $lineno;
                $op{$op}{$args}{status} |= 1;
            }
        }
        elsif ( $line =~ /^(inline )?\s*op\s*(\S+)\s*\((.*?)\)/ ) {
            $op{$2}{$3}{def} = $lineno;
            $op{$2}{$3}{status} |= 2;
        }
    }
    analyse( $filename, \%op );
}

foreach my $file (<src/ops/*.ops>) {
    check_op_doc $file;
}

ok( !@docerr, 'opcode documentation' ) or diag("Opcode documentation errors:\n@docerr");

# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.