top-complexity (3654B)
1 #!/usr/bin/env perl 2 #*************************************************************************** 3 # _ _ ____ _ 4 # Project ___| | | | _ \| | 5 # / __| | | | |_) | | 6 # | (__| |_| | _ <| |___ 7 # \___|\___/|_| \_\_____| 8 # 9 # Copyright (C) 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 # SPDX-License-Identifier: curl 23 # 24 ########################################################################### 25 26 use strict; 27 use warnings; 28 29 ####################################################################### 30 # Check for a command in the PATH of the test server. 31 # 32 sub checkcmd { 33 my ($cmd)=@_; 34 my @paths; 35 if($^O eq 'MSWin32' || $^O eq 'dos' || $^O eq 'os2') { 36 # PATH separator is different 37 @paths=(split(';', $ENV{'PATH'})); 38 } 39 else { 40 @paths=(split(':', $ENV{'PATH'}), "/usr/sbin", "/usr/local/sbin", 41 "/sbin", "/usr/bin", "/usr/local/bin"); 42 } 43 for(@paths) { 44 if(-x "$_/$cmd" && ! -d "$_/$cmd") { 45 # executable bit but not a directory! 46 return "$_/$cmd"; 47 } 48 } 49 return ""; 50 } 51 52 my $pmccabe = checkcmd("pmccabe"); 53 if(!$pmccabe) { 54 print "Make sure 'pmccabe' exists in your PATH\n"; 55 exit 1; 56 } 57 if(! -r "lib/url.c" || ! -r "lib/urldata.h") { 58 print "Invoke this script in the curl source tree root\n"; 59 exit 1; 60 } 61 62 my @files; 63 open(F, "git ls-files '*.c'|"); 64 while(<F>) { 65 chomp $_; 66 my $file = $_; 67 # we can't filter these with git so do it here 68 if($file =~ /^(lib|src)/) { 69 push @files, $file; 70 } 71 } 72 73 my $cmd = "$pmccabe ".join(" ", @files); 74 my @output=`$cmd`; 75 76 # these functions can have these scores, but not higher 77 my %whitelist = ( 78 79 ); 80 81 # functions with complexity above this level causes the function to return error 82 my $cutoff = 90; 83 84 # functions above this complexity level are shown 85 my $show = 65; 86 87 my $error = 0; 88 my %where; 89 my %perm; 90 my $allscore = 0; 91 my $alllines = 0; 92 # each line starts with the complexity score 93 # 142 417 809 1677 1305 src/tool_getparam.c(1677): getparameter 94 for my $l (@output) { 95 chomp $l; 96 if($l =~/^(\d+)\t\d+\t\d+\t\d+\t(\d+)\t([^\(]+).*: ([^ ]*)/) { 97 my ($score, $len, $path, $func)=($1, $2, $3, $4); 98 99 if($score > $show) { 100 my $allow = 0; 101 if($whitelist{$func} && 102 ($score <= $whitelist{$func})) { 103 $allow = 1; 104 } 105 $where{"$path:$func"}=$score; 106 $perm{"$path:$func"}=$allow; 107 if(($score > $cutoff) && !$allow) { 108 $error++; 109 } 110 } 111 $alllines += $len; 112 $allscore += ($len * $score); 113 } 114 115 } 116 117 my $showncutoff; 118 for my $e (sort {$where{$b} <=> $where{$a}} keys %where) { 119 if(!$showncutoff && 120 ($where{$e} <= $cutoff)) { 121 print "\n---- threshold: $cutoff ----\n\n"; 122 $showncutoff = 1; 123 } 124 printf "%-5d %s%s\n", $where{$e}, $e, 125 $perm{$e} ? " [ALLOWED]": ""; 126 } 127 128 printf "\nAverage complexity: %.2f\n", $allscore / $alllines; 129 130 exit $error;