helper.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Getopt::Long;
   7 use File::Find 'find';
   8 use File::Basename 'basename';
   9 use File::Glob 'bsd_glob';
  10
  11 sub read_file {
  12   my $f = shift;
  13   open my $fh, "<", $f or die "FATAL: read_rawfile() cannot open file '$f': $!";
  14   binmode $fh;
  15   return do { local $/; <$fh> };
  16 }
  17
  18 sub write_file {
  19   my ($f, $data) = @_;
  20   die "FATAL: write_file() no data" unless defined $data;
  21   open my $fh, ">", $f or die "FATAL: write_file() cannot open file '$f': $!";
  22   binmode $fh;
  23   print $fh $data or die "FATAL: write_file() cannot write to '$f': $!";
  24   close $fh or die "FATAL: write_file() cannot close '$f': $!";
  25   return;
  26 }
  27
  28 sub sanitize_comments {
  29   my($content) = @_;
  30   $content =~ s{/\*(.*?)\*/}{my $x=$1; $x =~ s/\w/x/g; "/*$x*/";}egs;
  31   return $content;
  32 }
  33
  34 sub check_source {
  35   my @all_files = (
  36         bsd_glob("makefile*"),
  37         bsd_glob("*.{h,c,sh,pl}"),
  38         bsd_glob("*/*.{h,c,sh,pl}"),
  39   );
  40
  41   my $fails = 0;
  42   for my $file (sort @all_files) {
  43     my $troubles = {};
  44     my $lineno = 1;
  45     my $content = read_file($file);
  46     $content = sanitize_comments $content;
  47     push @{$troubles->{crlf_line_end}}, '?' if $content =~ /\r/;
  48     for my $l (split /\n/, $content) {
  49       push @{$troubles->{merge_conflict}},     $lineno if $l =~ /^(<<<<<<<|=======|>>>>>>>)([^<=>]|$)/;
  50       push @{$troubles->{trailing_space}},     $lineno if $l =~ / $/;
  51       push @{$troubles->{tab}},                $lineno if $l =~ /\t/ && basename($file) !~ /^makefile/i;
  52       push @{$troubles->{non_ascii_char}},     $lineno if $l =~ /[^[:ascii:]]/;
  53       push @{$troubles->{cpp_comment}},        $lineno if $file =~ /\.(c|h)$/ && ($l =~ /\s\/\// || $l =~ /\/\/\s/);
  54       # we prefer using MP_MALLOC, MP_FREE, MP_REALLOC, MP_CALLOC ...
  55       push @{$troubles->{unwanted_malloc}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmalloc\s*\(/;
  56       push @{$troubles->{unwanted_realloc}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\brealloc\s*\(/;
  57       push @{$troubles->{unwanted_calloc}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bcalloc\s*\(/;
  58       push @{$troubles->{unwanted_free}},      $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bfree\s*\(/;
  59       # and we probably want to also avoid the following
  60       push @{$troubles->{unwanted_memcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcpy\s*\(/ && $file !~ /s_mp_copy_digs.c/;
  61       push @{$troubles->{unwanted_memset}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemset\s*\(/ && $file !~ /s_mp_zero_buf.c/ && $file !~ /s_mp_zero_digs.c/;
  62       push @{$troubles->{unwanted_memmove}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemmove\s*\(/;
  63       push @{$troubles->{unwanted_memcmp}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bmemcmp\s*\(/;
  64       push @{$troubles->{unwanted_strcmp}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcmp\s*\(/;
  65       push @{$troubles->{unwanted_strcpy}},    $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrcpy\s*\(/;
  66       push @{$troubles->{unwanted_strncpy}},   $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bstrncpy\s*\(/;
  67       push @{$troubles->{unwanted_clock}},     $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bclock\s*\(/;
  68       push @{$troubles->{unwanted_qsort}},     $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bqsort\s*\(/;
  69       push @{$troubles->{sizeof_no_brackets}}, $lineno if $file =~ /^[^\/]+\.c$/ && $l =~ /\bsizeof\s*[^\(]/;
  70       if ($file =~ m|^[^\/]+\.c$| && $l =~ /^static(\s+[a-zA-Z0-9_]+)+\s+([a-zA-Z0-9_]+)\s*\(/) {
  71         my $funcname = $2;
  72         # static functions should start with s_
  73         push @{$troubles->{staticfunc_name}}, "$lineno($funcname)" if $funcname !~ /^s_/;
  74       }
  75       $lineno++;
  76     }
  77     for my $k (sort keys %$troubles) {
  78       warn "[$k] $file line:" . join(",", @{$troubles->{$k}}) . "\n";
  79       $fails++;
  80     }
  81   }
  82
  83   warn( $fails > 0 ? "check-source:    FAIL $fails\n" : "check-source:    PASS\n" );
  84   return $fails;
  85 }
  86
  87 sub check_comments {
  88   my $fails = 0;
  89   my $first_comment = <<'MARKER';
  90 /* LibTomMath, multiple-precision integer library -- Tom St Denis */
  91 /* SPDX-License-Identifier: Unlicense */
  92 MARKER
  93   #my @all_files = (bsd_glob("*.{h,c}"), bsd_glob("*/*.{h,c}"));
  94   my @all_files = (bsd_glob("*.{h,c}"));
  95   for my $f (@all_files) {
  96     my $txt = read_file($f);
  97     if ($txt !~ /\Q$first_comment\E/s) {
  98       warn "[first_comment] $f\n";
  99       $fails++;
 100     }
 101   }
 102   warn( $fails > 0 ? "check-comments:  FAIL $fails\n" : "check-comments:  PASS\n" );
 103   return $fails;
 104 }
 105
 106 sub check_doc {
 107   my $fails = 0;
 108   my $man = read_file('doc/tommath.3');
 109   my $tex = read_file('doc/bn.tex');
 110   my $tmh = read_file('tommath.h');
 111   my @functions = $tmh =~ /\n\s*[a-zA-Z0-9_* ]+?(mp_[a-z0-9_]+)\s*\([^\)]+\)\s*[MP_WUR]+?;/sg;
 112   my @macros    = $tmh =~ /\n\s*#define\s+([a-z0-9_]+)\s*\([^\)]+\)/sg;
 113   for my $n (sort @functions) {
 114     (my $nn = $n) =~ s/_/\\_/g; # mp_sub_d >> mp\_sub\_d
 115     if ($tex !~ /index\Q{$nn}\E/) {
 116       warn "[missing_doc_for_function] $n\n";
 117       $fails++
 118     }
 119   }
 120   for my $n (sort @macros) {
 121     (my $nn = $n) =~ s/_/\\_/g; # mp_iszero >> mp\_iszero
 122     if ($tex !~ /index\Q{$nn}\E/) {
 123       warn "[missing_doc_for_macro] $n\n";
 124       $fails++
 125     }
 126   }
 127   for my $n (sort @functions) {
 128     if ($man !~ /.BI.*$n/) {
 129       warn "[missing_man_entry_for_function] $n\n";
 130       $fails++
 131     }
 132   }
 133   for my $n (sort @macros) {
 134     if ($man !~ /.BI.*$n/) {
 135       warn "[missing_man_entry_for_macro] $n\n";
 136       $fails++
 137     }
 138   }
 139   warn( $fails > 0 ? "check_doc:       FAIL $fails\n" : "check-doc:       PASS\n" );
 140   return $fails;
 141 }
 142
 143 sub prepare_variable {
 144   my ($varname, @list) = @_;
 145   my $output = "$varname=";
 146   my $len = length($output);
 147   foreach my $obj (sort @list) {
 148     $len = $len + length $obj;
 149     $obj =~ s/\*/\$/;
 150     if ($len > 100) {
 151       $output .= "\\\n";
 152       $len = length $obj;
 153     }
 154     $output .= $obj . ' ';
 155   }
 156   $output =~ s/ $//;
 157   return $output;
 158 }
 159
 160 sub prepare_msvc_files_xml {
 161   my ($all, $exclude_re, $targets) = @_;
 162   my $last = [];
 163   my $depth = 2;
 164
 165   # sort files in the same order as visual studio (ugly, I know)
 166   my @parts = ();
 167   for my $orig (@$all) {
 168     my $p = $orig;
 169     $p =~ s|/|/~|g;
 170     $p =~ s|/~([^/]+)$|/$1|g;
 171     my @l = map { sprintf "% -99s", $_ } split /\//, $p;
 172     push @parts, [ $orig, join(':', @l) ];
 173   }
 174   my @sorted = map { $_->[0] } sort { $a->[1] cmp $b->[1] } @parts;
 175
 176   my $files = "<Files>\r\n";
 177   for my $full (@sorted) {
 178     my @items = split /\//, $full; # split by '/'
 179     $full =~ s|/|\\|g;             # replace '/' bt '\'
 180     shift @items; # drop first one (src)
 181     pop @items;   # drop last one (filename.ext)
 182     my $current = \@items;
 183     if (join(':', @$current) ne join(':', @$last)) {
 184       my $common = 0;
 185       $common++ while ($last->[$common] && $current->[$common] && $last->[$common] eq $current->[$common]);
 186       my $back = @$last - $common;
 187       if ($back > 0) {
 188         $files .= ("\t" x --$depth) . "</Filter>\r\n" for (1..$back);
 189       }
 190       my $fwd = [ @$current ]; splice(@$fwd, 0, $common);
 191       for my $i (0..scalar(@$fwd) - 1) {
 192         $files .= ("\t" x $depth) . "<Filter\r\n";
 193         $files .= ("\t" x $depth) . "\tName=\"$fwd->[$i]\"\r\n";
 194         $files .= ("\t" x $depth) . "\t>\r\n";
 195         $depth++;
 196       }
 197       $last = $current;
 198     }
 199     $files .= ("\t" x $depth) . "<File\r\n";
 200     $files .= ("\t" x $depth) . "\tRelativePath=\"$full\"\r\n";
 201     $files .= ("\t" x $depth) . "\t>\r\n";
 202     if ($full =~ $exclude_re) {
 203       for (@$targets) {
 204         $files .= ("\t" x $depth) . "\t<FileConfiguration\r\n";
 205         $files .= ("\t" x $depth) . "\t\tName=\"$_\"\r\n";
 206         $files .= ("\t" x $depth) . "\t\tExcludedFromBuild=\"true\"\r\n";
 207         $files .= ("\t" x $depth) . "\t\t>\r\n";
 208         $files .= ("\t" x $depth) . "\t\t<Tool\r\n";
 209         $files .= ("\t" x $depth) . "\t\t\tName=\"VCCLCompilerTool\"\r\n";
 210         $files .= ("\t" x $depth) . "\t\t\tAdditionalIncludeDirectories=\"\"\r\n";
 211         $files .= ("\t" x $depth) . "\t\t\tPreprocessorDefinitions=\"\"\r\n";
 212         $files .= ("\t" x $depth) . "\t\t/>\r\n";
 213         $files .= ("\t" x $depth) . "\t</FileConfiguration>\r\n";
 214       }
 215     }
 216     $files .= ("\t" x $depth) . "</File>\r\n";
 217   }
 218   $files .= ("\t" x --$depth) . "</Filter>\r\n" for (@$last);
 219   $files .= "\t</Files>";
 220   return $files;
 221 }
 222
 223 sub patch_file {
 224   my ($content, @variables) = @_;
 225   for my $v (@variables) {
 226     if ($v =~ /^([A-Z0-9_]+)\s*=.*$/si) {
 227       my $name = $1;
 228       $content =~ s/\n\Q$name\E\b.*?[^\\]\n/\n$v\n/s;
 229     }
 230     else {
 231       die "patch_file failed: " . substr($v, 0, 30) . "..";
 232     }
 233   }
 234   return $content;
 235 }
 236
 237 sub make_sources_cmake {
 238   my ($src_ref, $hdr_ref) = @_;
 239   my @sources = @{ $src_ref };
 240   my @headers = @{ $hdr_ref };
 241   my $output = "# SPDX-License-Identifier: Unlicense
 242 # Autogenerated File! Do not edit.
 243
 244 set(SOURCES\n";
 245   foreach my $sobj (sort @sources) {
 246     $output .= $sobj . "\n";
 247   }
 248   $output .= ")\n\nset(HEADERS\n";
 249   foreach my $hobj (sort @headers) {
 250     $output .= $hobj . "\n";
 251   }
 252   $output .= ")\n";
 253   return $output;
 254 }
 255
 256 sub process_makefiles {
 257   my $write = shift;
 258   my $changed_count = 0;
 259   my @headers = bsd_glob("*.h");
 260   my @sources = bsd_glob("*.c");
 261   my @o = map { my $x = $_; $x =~ s/\.c$/.o/; $x } @sources;
 262   my @all = sort(@sources, @headers);
 263
 264   my $var_o = prepare_variable("OBJECTS", @o);
 265   (my $var_obj = $var_o) =~ s/\.o\b/.obj/sg;
 266
 267   # update MSVC project files
 268   my $msvc_files = prepare_msvc_files_xml(\@all, qr/NOT_USED_HERE/, ['Debug|Win32', 'Release|Win32', 'Debug|x64', 'Release|x64']);
 269   for my $m (qw/libtommath_VS2008.vcproj/) {
 270     my $old = read_file($m);
 271     my $new = $old;
 272     $new =~ s|<Files>.*</Files>|$msvc_files|s;
 273     if ($old ne $new) {
 274       write_file($m, $new) if $write;
 275       warn "changed: $m\n";
 276       $changed_count++;
 277     }
 278   }
 279
 280   # update OBJECTS + HEADERS in makefile*
 281   for my $m (qw/ makefile makefile.shared makefile_include.mk makefile.msvc makefile.unix makefile.mingw sources.cmake /) {
 282     my $old = read_file($m);
 283     my $new = $m eq 'makefile.msvc' ? patch_file($old, $var_obj)
 284             : $m eq 'sources.cmake' ? make_sources_cmake(\@sources, \@headers)
 285             :                         patch_file($old, $var_o);
 286
 287     if ($old ne $new) {
 288       write_file($m, $new) if $write;
 289       warn "changed: $m\n";
 290       $changed_count++;
 291     }
 292   }
 293
 294   if ($write) {
 295     return 0; # no failures
 296   }
 297   else {
 298     warn( $changed_count > 0 ? "check-makefiles: FAIL $changed_count\n" : "check-makefiles: PASS\n" );
 299     return $changed_count;
 300   }
 301 }
 302
 303 sub draw_func
 304 {
 305    my ($deplist, $depmap, $out, $indent, $funcslist) = @_;
 306    my @funcs = split ',', $funcslist;
 307    # try this if you want to have a look at a minimized version of the callgraph without all the trivial functions
 308    #if ($deplist =~ /$funcs[0]/ || $funcs[0] =~ /MP_(ADD|SUB|CLEAR|CLEAR_\S+|DIV|MUL|COPY|ZERO|GROW|CLAMP|INIT|INIT_\S+|SET|ABS|CMP|CMP_D|EXCH)_C/) {
 309    if ($deplist =~ /$funcs[0]/) {
 310       return $deplist;
 311    } else {
 312       $deplist = $deplist . $funcs[0];
 313    }
 314    if ($indent == 0) {
 315    } elsif ($indent >= 1) {
 316       print {$out} '|   ' x ($indent - 1) . '+--->';
 317    }
 318    print {$out} $funcs[0] . "\n";
 319    shift @funcs;
 320    my $olddeplist = $deplist;
 321    foreach my $i (@funcs) {
 322       $deplist = draw_func($deplist, $depmap, $out, $indent + 1, ${$depmap}{$i}) if exists ${$depmap}{$i};
 323    }
 324    return $olddeplist;
 325 }
 326
 327 sub update_dep
 328 {
 329     #open class file and write preamble
 330     open(my $class, '>', 'tommath_class.h') or die "Couldn't open tommath_class.h for writing\n";
 331     print {$class} << 'EOS';
 332 /* LibTomMath, multiple-precision integer library -- Tom St Denis */
 333 /* SPDX-License-Identifier: Unlicense */
 334
 335 #if !(defined(LTM1) && defined(LTM2) && defined(LTM3))
 336 #define LTM_INSIDE
 337 #if defined(LTM2)
 338 #   define LTM3
 339 #endif
 340 #if defined(LTM1)
 341 #   define LTM2
 342 #endif
 343 #define LTM1
 344 #if defined(LTM_ALL)
 345 EOS
 346
 347     foreach my $filename (glob '*mp_*.c') {
 348         my $define = $filename;
 349
 350         print "Processing $filename\n";
 351
 352         # convert filename to upper case so we can use it as a define
 353         $define =~ tr/[a-z]/[A-Z]/;
 354         $define =~ tr/\./_/;
 355         print {$class} "#   define $define\n";
 356
 357         # now copy text and apply #ifdef as required
 358         my $apply = 0;
 359         open(my $src, '<', $filename);
 360         open(my $out, '>', 'tmp');
 361
 362         # first line will be the #ifdef
 363         my $line = <$src>;
 364         if ($line =~ /include/) {
 365             print {$out} $line;
 366         } else {
 367             print {$out} << "EOS";
 368 #include "tommath_private.h"
 369 #ifdef $define
 370 /* LibTomMath, multiple-precision integer library -- Tom St Denis */
 371 /* SPDX-License-Identifier: Unlicense */
 372 $line
 373 EOS
 374             $apply = 1;
 375         }
 376         while (<$src>) {
 377             if ($_ !~ /tommath\.h/) {
 378                 print {$out} $_;
 379             }
 380         }
 381         if ($apply == 1) {
 382             print {$out} "#endif\n";
 383         }
 384         close $src;
 385         close $out;
 386
 387         unlink $filename;
 388         rename 'tmp', $filename;
 389     }
 390     print {$class} "#endif\n#endif\n";
 391
 392     # now do classes
 393     my %depmap;
 394     foreach my $filename (glob '*mp_*.c') {
 395         my $content;
 396         my $cc = $ENV{'CC'} || 'gcc';
 397         $content = `$cc -E -x c -DLTM_ALL -DMP_SMALL_STACK_SIZE $filename`;
 398         $content =~ s/^# 1 "$filename".*?^# 2 "$filename"//ms;
 399
 400         # convert filename to upper case so we can use it as a define
 401         $filename =~ tr/[a-z]/[A-Z]/;
 402         $filename =~ tr/\./_/;
 403
 404         print {$class} "#if defined($filename)\n";
 405         my $list = $filename;
 406
 407         # strip comments
 408         $content =~ s{/\*.*?\*/}{}gs;
 409
 410         # scan for mp_* and make classes
 411         my @deps = ();
 412         foreach my $line (split /\n/, $content) {
 413             while ($line =~ /(fast_)?(s_)?mp\_[a-z_0-9]*((?=\;)|(?=\())|(?<=\()mp\_[a-z_0-9]*(?=\()/g) {
 414                 my $a = $&;
 415                 next if $a eq "mp_err";
 416                 $a =~ tr/[a-z]/[A-Z]/;
 417                 $a = $a . '_C';
 418                 push @deps, $a;
 419             }
 420         }
 421         @deps = sort(@deps);
 422         foreach my $a (@deps) {
 423             if ($list !~ /$a/) {
 424                 print {$class} "#   define $a\n";
 425             }
 426             $list = $list . ',' . $a;
 427         }
 428         $depmap{$filename} = $list;
 429
 430         print {$class} "#endif\n\n";
 431     }
 432
 433     print {$class} << 'EOS';
 434 #ifdef LTM_INSIDE
 435 #undef LTM_INSIDE
 436 #ifdef LTM3
 437 #   define LTM_LAST
 438 #endif
 439
 440 #include "tommath_superclass.h"
 441 #include "tommath_class.h"
 442 #else
 443 #   define LTM_LAST
 444 #endif
 445 EOS
 446     close $class;
 447
 448     #now let's make a cool call graph...
 449
 450     open(my $out, '>', 'callgraph.txt');
 451     foreach (sort keys %depmap) {
 452         draw_func("", \%depmap, $out, 0, $depmap{$_});
 453         print {$out} "\n\n";
 454     }
 455     close $out;
 456
 457     return 0;
 458 }
 459
 460 sub generate_def {
 461     my @files = glob '*mp_*.c';
 462     @files = map { my $x = $_; $x =~ s/\.c$//g; $x; } @files;
 463     @files = grep(!/mp_cutoffs/, @files);
 464
 465     my $files = join("\n    ", sort(grep(/^mp_/, @files)));
 466     write_file "tommath.def", "; libtommath
 467 ;
 468 ; Use this command to produce a 32-bit .lib file, for use in any MSVC version
 469 ;   lib -machine:X86 -name:libtommath.dll -def:tommath.def -out:tommath.lib
 470 ; Use this command to produce a 64-bit .lib file, for use in any MSVC version
 471 ;   lib -machine:X64 -name:libtommath.dll -def:tommath.def -out:tommath.lib
 472 ;
 473 EXPORTS
 474     $files
 475     MP_MUL_KARATSUBA_CUTOFF
 476     MP_SQR_KARATSUBA_CUTOFF
 477     MP_MUL_TOOM_CUTOFF
 478     MP_SQR_TOOM_CUTOFF
 479 ";
 480     return 0;
 481 }
 482
 483 sub die_usage {
 484   die <<"MARKER";
 485 usage: $0 -s   OR   $0 --check-source
 486        $0 -o   OR   $0 --check-comments
 487        $0 -m   OR   $0 --check-makefiles
 488        $0 -d   OR   $0 --check-doc
 489        $0 -a   OR   $0 --check-all
 490        $0 -u   OR   $0 --update-files
 491 MARKER
 492 }
 493
 494 GetOptions( "s|check-source"        => \my $check_source,
 495             "o|check-comments"      => \my $check_comments,
 496             "m|check-makefiles"     => \my $check_makefiles,
 497             "d|check-doc"           => \my $check_doc,
 498             "a|check-all"           => \my $check_all,
 499             "u|update-files"        => \my $update_files,
 500             "h|help"                => \my $help
 501           ) or die_usage;
 502
 503 my $failure;
 504 $failure ||= check_source()       if $check_all || $check_source;
 505 $failure ||= check_comments()     if $check_all || $check_comments;
 506 $failure ||= check_doc()          if $check_all || $check_doc;
 507 $failure ||= process_makefiles(0) if $check_all || $check_makefiles;
 508 $failure ||= process_makefiles(1) if $update_files;
 509 $failure ||= update_dep()         if $update_files;
 510 $failure ||= generate_def()       if $update_files;
 511
 512 die_usage unless defined $failure;
 513 exit $failure ? 1 : 0;