check-doxy-blocks.pl 2.4 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879
  1. #!/usr/bin/env perl
  2. # Detect comment blocks that are likely meant to be doxygen blocks but aren't.
  3. #
  4. # More precisely, look for normal comment block containing '\'.
  5. # Of course one could use doxygen warnings, eg with:
  6. # sed -e '/EXTRACT/s/YES/NO/' doxygen/mbedtls.doxyfile | doxygen -
  7. # but that would warn about any undocumented item, while our goal is to find
  8. # items that are documented, but not marked as such by mistake.
  9. #
  10. # Copyright The Mbed TLS Contributors
  11. # SPDX-License-Identifier: Apache-2.0
  12. #
  13. # Licensed under the Apache License, Version 2.0 (the "License"); you may
  14. # not use this file except in compliance with the License.
  15. # You may obtain a copy of the License at
  16. #
  17. # http://www.apache.org/licenses/LICENSE-2.0
  18. #
  19. # Unless required by applicable law or agreed to in writing, software
  20. # distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
  21. # WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  22. # See the License for the specific language governing permissions and
  23. # limitations under the License.
  24. use warnings;
  25. use strict;
  26. use File::Basename;
  27. # C/header files in the following directories will be checked
  28. my @directories = qw(include/mbedtls library doxygen/input);
  29. # very naive pattern to find directives:
  30. # everything with a backslach except '\0' and backslash at EOL
  31. my $doxy_re = qr/\\(?!0|\n)/;
  32. # Return an error code to the environment if a potential error in the
  33. # source code is found.
  34. my $exit_code = 0;
  35. sub check_file {
  36. my ($fname) = @_;
  37. open my $fh, '<', $fname or die "Failed to open '$fname': $!\n";
  38. # first line of the last normal comment block,
  39. # or 0 if not in a normal comment block
  40. my $block_start = 0;
  41. while (my $line = <$fh>) {
  42. $block_start = $. if $line =~ m/\/\*(?![*!])/;
  43. $block_start = 0 if $line =~ m/\*\//;
  44. if ($block_start and $line =~ m/$doxy_re/) {
  45. print "$fname:$block_start: directive on line $.\n";
  46. $block_start = 0; # report only one directive per block
  47. $exit_code = 1;
  48. }
  49. }
  50. close $fh;
  51. }
  52. sub check_dir {
  53. my ($dirname) = @_;
  54. for my $file (<$dirname/*.[ch]>) {
  55. check_file($file);
  56. }
  57. }
  58. # Check that the script is being run from the project's root directory.
  59. for my $dir (@directories) {
  60. if (! -d $dir) {
  61. die "This script must be run from the mbed TLS root directory";
  62. } else {
  63. check_dir($dir)
  64. }
  65. }
  66. exit $exit_code;
  67. __END__