Skip to content
This repository
Newer
Older
100644 96 lines (75 sloc) 2.355 kb
2417d992 » particle
2005-11-23 test reorg 4: standardize test headers
1 #! perl
4eb5deb4 » mikehh
2010-02-22 fix codetest failures - fix Copyright
2 # Copyright (C) 2001-2010, Parrot Foundation.
2417d992 » particle
2005-11-23 test reorg 4: standardize test headers
3
4 use strict;
5 use warnings;
6 use lib qw( . lib ../lib ../../lib );
7 use Test::More tests => 1;
8
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
9 =head1 NAME
10
726438de » coke
2009-03-11 Rename file to match other filenames in this dir.
11 t/perl/opcode_doc.t - check opcode documentation
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
12
13 =head1 SYNOPSIS
14
726438de » coke
2009-03-11 Rename file to match other filenames in this dir.
15 % prove t/perl/opcode_doc.t
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
16
17 =head1 DESCRIPTION
18
11ce92bf » bschmalhofer
2005-10-31 Skip the $svn_miss test, as at least 'debian' is quite
19 Checks whether all opcodes are documented.
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
20
21 =cut
22
23 my @docerr;
24
25 sub slurp {
26 my ($filename) = @_;
11ce92bf » bschmalhofer
2005-10-31 Skip the $svn_miss test, as at least 'debian' is quite
27
79d29562 » particle
2006-10-18 [PDD07]: ws & non-ws fixes for t/benchmark/, t/configure/, t/distro/,…
28 open my $FILE, '<', "$filename" or die "can't open '$filename' for reading";
29 my @file = <$FILE>;
30 close $FILE;
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
31 return @file;
32 }
33
34 sub analyse {
28f44b7c » paultcochrane
2006-12-17 [t] Tidied Perl source with perltidy. (part 29)
35 my ( $filename, $ops ) = @_;
11ce92bf » bschmalhofer
2005-10-31 Skip the $svn_miss test, as at least 'debian' is quite
36
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
37 my %file;
ece6d256 » rspier
2005-09-28 r8531@bear (orig r8531): leo | 2005-07-06 08:18:23 -0700
38
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
39 foreach my $op ( keys %$ops ) {
40 my $args = $ops->{$op};
ece6d256 » rspier
2005-09-28 r8531@bear (orig r8531): leo | 2005-07-06 08:18:23 -0700
41 next if $op =~ /^DELETED/;
28f44b7c » paultcochrane
2006-12-17 [t] Tidied Perl source with perltidy. (part 29)
42 next if $op =~ /^isgt/; # doced but rewritten
72453d3c » Leopold Toetsch
2005-10-07 update opcode-doc.t
43 next if $op =~ /^isge/;
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
44 foreach my $arg ( keys %$args ) {
28f44b7c » paultcochrane
2006-12-17 [t] Tidied Perl source with perltidy. (part 29)
45 my $e = $args->{$arg};
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
46 my $val = $e->{status};
28f44b7c » paultcochrane
2006-12-17 [t] Tidied Perl source with perltidy. (part 29)
47 next if $val == 3; # doc & impl
48 $file{ $e->{def} } = "no documentation for $op($arg)" if exists $e->{def};
49 $file{ $e->{doc} } = "no definition of $op($arg)" if exists $e->{doc};
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
50 }
51 }
52
28f44b7c » paultcochrane
2006-12-17 [t] Tidied Perl source with perltidy. (part 29)
53 foreach my $line ( sort { $a <=> $b } keys %file ) {
11ce92bf » bschmalhofer
2005-10-31 Skip the $svn_miss test, as at least 'debian' is quite
54 push @docerr, "$filename:$line: $file{$line}\n";
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
55 }
56 }
57
58 sub check_op_doc {
59 my ($filename) = @_;
11ce92bf » bschmalhofer
2005-10-31 Skip the $svn_miss test, as at least 'debian' is quite
60
28f44b7c » paultcochrane
2006-12-17 [t] Tidied Perl source with perltidy. (part 29)
61 my @file = slurp($filename);
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
62 my %op;
63 my $lineno = 0;
ece6d256 » rspier
2005-09-28 r8531@bear (orig r8531): leo | 2005-07-06 08:18:23 -0700
64
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
65 foreach my $line (@file) {
66 ++$lineno;
28f44b7c » paultcochrane
2006-12-17 [t] Tidied Perl source with perltidy. (part 29)
67 if ( my ($item) = $line =~ /^=item\s+(.+\(.*)/ ) {
68 if ( $item =~ /^([BC])\<(.*)\>\s*\((.*?)\)/ ) {
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
69 print "$filename:$lineno: use B<...> instead of C<...>\n"
70 if $1 eq "C";
28f44b7c » paultcochrane
2006-12-17 [t] Tidied Perl source with perltidy. (part 29)
71 my ( $op, $args ) = ( $2, $3 );
72 $args =~ s!\s*/\*.*?\*/!!; # del C comment in args
8dc5a539 » Leopold Toetsch
2005-06-24 fix opcode-doc.t
73 $op{$op}{$args}{doc} = $lineno;
74 $op{$op}{$args}{status} |= 1;
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
75 }
28f44b7c » paultcochrane
2006-12-17 [t] Tidied Perl source with perltidy. (part 29)
76 }
77 elsif ( $line =~ /^(inline )?\s*op\s*(\S+)\s*\((.*?)\)/ ) {
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
78 $op{$2}{$3}{def} = $lineno;
79 $op{$2}{$3}{status} |= 2;
80 }
81 }
82 analyse( $filename, \%op );
83 }
84
85b93c5a » coke
2009-03-11 [t] Test the ops files; before this commit, this file was a noop.
85 foreach my $file (<src/ops/*.ops>) {
c32c78d0 » Jens Rieks
2005-06-12 added automatic opcode documentation test
86 check_op_doc $file;
87 }
88
28f44b7c » paultcochrane
2006-12-17 [t] Tidied Perl source with perltidy. (part 29)
89 ok( !@docerr, 'opcode documentation' ) or diag("Opcode documentation errors:\n@docerr");
79d29562 » particle
2006-10-18 [PDD07]: ws & non-ws fixes for t/benchmark/, t/configure/, t/distro/,…
90
91 # Local Variables:
92 # mode: cperl
93 # cperl-indent-level: 4
94 # fill-column: 100
95 # End:
96 # vim: expandtab shiftwidth=4:
Something went wrong with that request. Please try again.