disable-scan.pl 3.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146
  1. #!/usr/bin/env perl
  2. #***************************************************************************
  3. # _ _ ____ _
  4. # Project ___| | | | _ \| |
  5. # / __| | | | |_) | |
  6. # | (__| |_| | _ <| |___
  7. # \___|\___/|_| \_\_____|
  8. #
  9. # Copyright (C) 2010 - 2021, Daniel Stenberg, <daniel@haxx.se>, et al.
  10. #
  11. # This software is licensed as described in the file COPYING, which
  12. # you should have received as part of this distribution. The terms
  13. # are also available at https://curl.se/docs/copyright.html.
  14. #
  15. # You may opt to use, copy, modify, merge, publish, distribute and/or sell
  16. # copies of the Software, and permit persons to whom the Software is
  17. # furnished to do so, under the terms of the COPYING file.
  18. #
  19. # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  20. # KIND, either express or implied.
  21. #
  22. ###########################################################################
  23. #
  24. use strict;
  25. use warnings;
  26. # the DISABLE options that can be set by configure
  27. my %disable;
  28. # the DISABLE options that are used in C files
  29. my %file;
  30. # the DISABLE options that are documented
  31. my %docs;
  32. # we may get the dir root pointed out
  33. my $root=$ARGV[0] || ".";
  34. my $DOCS="CURL-DISABLE.md";
  35. sub scanconf {
  36. my ($f)=@_;
  37. open S, "<$f";
  38. while(<S>) {
  39. if(/(CURL_DISABLE_[A-Z_]+)/g) {
  40. my ($sym)=($1);
  41. $disable{$sym} = 1;
  42. }
  43. }
  44. close S;
  45. }
  46. sub scan_configure {
  47. opendir(my $m, "$root/m4") || die "Can't opendir $root/m4: $!";
  48. my @m4 = grep { /\.m4$/ } readdir($m);
  49. closedir $m;
  50. scanconf("$root/configure.ac");
  51. # scan all m4 files too
  52. for my $e (@m4) {
  53. scanconf("$root/m4/$e");
  54. }
  55. }
  56. sub scan_file {
  57. my ($source)=@_;
  58. open F, "<$source";
  59. while(<F>) {
  60. if(/(CURL_DISABLE_[A-Z_]+)/g) {
  61. my ($sym)=($1);
  62. $file{$sym} = $source;
  63. }
  64. }
  65. close F;
  66. }
  67. sub scan_dir {
  68. my ($dir)=@_;
  69. opendir(my $dh, $dir) || die "Can't opendir $dir: $!";
  70. my @cfiles = grep { /\.[ch]\z/ && -f "$dir/$_" } readdir($dh);
  71. closedir $dh;
  72. for my $f (sort @cfiles) {
  73. scan_file("$dir/$f");
  74. }
  75. }
  76. sub scan_sources {
  77. scan_dir("$root/src");
  78. scan_dir("$root/lib");
  79. scan_dir("$root/lib/vtls");
  80. scan_dir("$root/lib/vauth");
  81. }
  82. sub scan_docs {
  83. open F, "<$root/docs/$DOCS";
  84. my $line = 0;
  85. while(<F>) {
  86. $line++;
  87. if(/^## (CURL_DISABLE_[A-Z_]+)/g) {
  88. my ($sym)=($1);
  89. $docs{$sym} = $line;
  90. }
  91. }
  92. close F;
  93. }
  94. scan_configure();
  95. scan_sources();
  96. scan_docs();
  97. my $error = 0;
  98. # Check the configure symbols for use in code
  99. for my $s (sort keys %disable) {
  100. if(!$file{$s}) {
  101. printf "Present in configure.ac, not used by code: %s\n", $s;
  102. $error++;
  103. }
  104. if(!$docs{$s}) {
  105. printf "Present in configure.ac, not documented in $DOCS: %s\n", $s;
  106. $error++;
  107. }
  108. }
  109. # Check the code symbols for use in configure
  110. for my $s (sort keys %file) {
  111. if(!$disable{$s}) {
  112. printf "Not set by configure: %s (%s)\n", $s, $file{$s};
  113. $error++;
  114. }
  115. if(!$docs{$s}) {
  116. printf "Used in code, not documented in $DOCS: %s\n", $s;
  117. $error++;
  118. }
  119. }
  120. # Check the documented symbols
  121. for my $s (sort keys %docs) {
  122. if(!$disable{$s}) {
  123. printf "Documented but not in configure: %s\n", $s;
  124. $error++;
  125. }
  126. if(!$file{$s}) {
  127. printf "Documented, but not used by code: %s\n", $s;
  128. $error++;
  129. }
  130. }
  131. exit $error;