Paul Bakker | 9a73632 | 2012-11-14 12:39:52 +0000 | [diff] [blame] | 1 | #!/usr/bin/perl |
| 2 | |
| 3 | # Detect comment blocks that are likely meant to be doxygen blocks but aren't. |
| 4 | # |
| 5 | # More precisely, look for normal comment block containing '\'. |
| 6 | # Of course one could use doxygen warnings, eg with: |
Manuel Pégourié-Gonnard | f234ff8 | 2015-01-22 17:01:27 +0000 | [diff] [blame] | 7 | # sed -e '/EXTRACT/s/YES/NO/' doxygen/mbedtls.doxyfile | doxygen - |
Paul Bakker | 9a73632 | 2012-11-14 12:39:52 +0000 | [diff] [blame] | 8 | # but that would warn about any undocumented item, while our goal is to find |
| 9 | # items that are documented, but not marked as such by mistake. |
| 10 | |
| 11 | use warnings; |
| 12 | use strict; |
| 13 | use File::Basename; |
| 14 | |
Manuel Pégourié-Gonnard | d09a6b5 | 2015-04-09 17:19:23 +0200 | [diff] [blame] | 15 | # C/header files in the following directories will be checked |
Manuel Pégourié-Gonnard | 7f80997 | 2015-03-09 17:05:11 +0000 | [diff] [blame] | 16 | my @directories = qw(include/mbedtls library doxygen/input); |
Paul Bakker | 9a73632 | 2012-11-14 12:39:52 +0000 | [diff] [blame] | 17 | |
| 18 | # very naive pattern to find directives: |
Manuel Pégourié-Gonnard | ef009ff | 2013-09-16 13:40:25 +0200 | [diff] [blame] | 19 | # everything with a backslach except '\0' and backslash at EOL |
| 20 | my $doxy_re = qr/\\(?!0|\n)/; |
Paul Bakker | 9a73632 | 2012-11-14 12:39:52 +0000 | [diff] [blame] | 21 | |
Andres Amaya Garcia | d3f0f5e | 2016-12-14 09:36:55 +0000 | [diff] [blame] | 22 | # Return an error code to the environment if a potential error in the |
| 23 | # source code is found. |
| 24 | my $exit_code = 0; |
| 25 | |
Paul Bakker | 9a73632 | 2012-11-14 12:39:52 +0000 | [diff] [blame] | 26 | sub check_file { |
| 27 | my ($fname) = @_; |
| 28 | open my $fh, '<', $fname or die "Failed to open '$fname': $!\n"; |
| 29 | |
| 30 | # first line of the last normal comment block, |
| 31 | # or 0 if not in a normal comment block |
| 32 | my $block_start = 0; |
| 33 | while (my $line = <$fh>) { |
| 34 | $block_start = $. if $line =~ m/\/\*(?![*!])/; |
| 35 | $block_start = 0 if $line =~ m/\*\//; |
| 36 | if ($block_start and $line =~ m/$doxy_re/) { |
| 37 | print "$fname:$block_start: directive on line $.\n"; |
| 38 | $block_start = 0; # report only one directive per block |
Andres Amaya Garcia | d3f0f5e | 2016-12-14 09:36:55 +0000 | [diff] [blame] | 39 | $exit_code = 1; |
Paul Bakker | 9a73632 | 2012-11-14 12:39:52 +0000 | [diff] [blame] | 40 | } |
| 41 | } |
| 42 | |
| 43 | close $fh; |
| 44 | } |
| 45 | |
| 46 | sub check_dir { |
| 47 | my ($dirname) = @_; |
| 48 | for my $file (<$dirname/*.[ch]>) { |
| 49 | check_file($file); |
| 50 | } |
| 51 | } |
| 52 | |
Andres Amaya Garcia | d3f0f5e | 2016-12-14 09:36:55 +0000 | [diff] [blame] | 53 | # Check that the script is being run from the project's root directory. |
Paul Bakker | 9a73632 | 2012-11-14 12:39:52 +0000 | [diff] [blame] | 54 | for my $dir (@directories) { |
Andres Amaya Garcia | d3f0f5e | 2016-12-14 09:36:55 +0000 | [diff] [blame] | 55 | if (! -d $dir) { |
| 56 | die "This script must be run from the mbed TLS root directory"; |
| 57 | } else { |
| 58 | check_dir($dir) |
| 59 | } |
Paul Bakker | 9a73632 | 2012-11-14 12:39:52 +0000 | [diff] [blame] | 60 | } |
| 61 | |
Andres Amaya Garcia | d3f0f5e | 2016-12-14 09:36:55 +0000 | [diff] [blame] | 62 | exit $exit_code; |
| 63 | |
Paul Bakker | 9a73632 | 2012-11-14 12:39:52 +0000 | [diff] [blame] | 64 | __END__ |