build-aux/useless-if-before-free

   1 #!/bin/sh
   2 #! -*-perl-*-
   3
   4 # Detect instances of "if (p) free (p);".
   5 # Likewise "if (p != 0)", "if (0 != p)", or with NULL; and with braces.
   6
   7 # Copyright (C) 2008-2021 Free Software Foundation, Inc.
   8 #
   9 # This program is free software: you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation, either version 3 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # This program is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  21 #
  22 # Written by Jim Meyering
  23
  24 # This is a prologue that allows to run a perl script as an executable
  25 # on systems that are compliant to a POSIX version before POSIX:2017.
  26 # On such systems, the usual invocation of an executable through execlp()
  27 # or execvp() fails with ENOEXEC if it is a script that does not start
  28 # with a #! line.  The script interpreter mentioned in the #! line has
  29 # to be /bin/sh, because on GuixSD systems that is the only program that
  30 # has a fixed file name.  The second line is essential for perl and is
  31 # also useful for editing this file in Emacs.  The next two lines below
  32 # are valid code in both sh and perl.  When executed by sh, they re-execute
  33 # the script through the perl program found in $PATH.  The '-x' option
  34 # is essential as well; without it, perl would re-execute the script
  35 # through /bin/sh.  When executed by perl, the next two lines are a no-op.
  36 eval 'exec perl -wSx "$0" "$@"'
  37      if 0;
  38
  39 my $VERSION = '2021-04-11 10:11'; # UTC
  40 # The definition above must lie within the first 8 lines in order
  41 # for the Emacs time-stamp write hook (at end) to update it.
  42 # If you change this file with Emacs, please let the write hook
  43 # do its job.  Otherwise, update this string manually.
  44
  45 my $copyright_year = '2021';
  46
  47 use strict;
  48 use warnings;
  49 use Getopt::Long;
  50
  51 (my $ME = $0) =~ s|.*/||;
  52
  53 # use File::Coda; # https://meyering.net/code/Coda/
  54 END {
  55   defined fileno STDOUT or return;
  56   close STDOUT and return;
  57   warn "$ME: failed to close standard output: $!\n";
  58   $? ||= 1;
  59 }
  60
  61 sub usage ($)
  62 {
  63   my ($exit_code) = @_;
  64   my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
  65   if ($exit_code != 0)
  66     {
  67       print $STREAM "Try '$ME --help' for more information.\n";
  68     }
  69   else
  70     {
  71       print $STREAM <<EOF;
  72 Usage: $ME [OPTIONS] FILE...
  73
  74 Detect any instance in FILE of a useless "if" test before a free call, e.g.,
  75 "if (p) free (p);".  Any such test may be safely removed without affecting
  76 the semantics of the C code in FILE.  Use --name=FOO --name=BAR to also
  77 detect free-like functions named FOO and BAR.
  78
  79 OPTIONS:
  80
  81    --list       print only the name of each matching FILE (\\0-terminated)
  82    --name=N     add name N to the list of \'free\'-like functions to detect;
  83                   may be repeated
  84
  85    --help       display this help and exit
  86    --version    output version information and exit
  87
  88 Exit status:
  89
  90   0   one or more matches
  91   1   no match
  92   2   an error
  93
  94 EXAMPLE:
  95
  96 For example, this command prints all removable "if" tests before "free"
  97 and "kfree" calls in the linux kernel sources:
  98
  99     git ls-files -z |xargs -0 $ME --name=kfree
 100
 101 EOF
 102     }
 103   exit $exit_code;
 104 }
 105
 106 sub is_NULL ($)
 107 {
 108   my ($expr) = @_;
 109   return ($expr eq 'NULL' || $expr eq '0');
 110 }
 111
 112 {
 113   sub EXIT_MATCH {0}
 114   sub EXIT_NO_MATCH {1}
 115   sub EXIT_ERROR {2}
 116   my $err = EXIT_NO_MATCH;
 117
 118   my $list;
 119   my @name = qw(free);
 120   GetOptions
 121     (
 122      help => sub { usage 0 },
 123      version =>
 124        sub
 125        {
 126          print "$ME version $VERSION\n";
 127          print "Copyright (C) $copyright_year Free Software Foundation, Inc.\n";
 128          print "License GPLv3+: GNU GPL version 3 or later <https://gnu.org/licenses/gpl.html>.\n"
 129              . "This is free software: you are free to change and redistribute it.\n"
 130              . "There is NO WARRANTY, to the extent permitted by law.\n";
 131          print "\n";
 132          my $author = "Jim Meyering";
 133          print "Written by $author.\n";
 134          exit
 135        },
 136      list => \$list,
 137      'name=s@' => \@name,
 138     ) or usage 1;
 139
 140   # Make sure we have the right number of non-option arguments.
 141   # Always tell the user why we fail.
 142   @ARGV < 1
 143     and (warn "$ME: missing FILE argument\n"), usage EXIT_ERROR;
 144
 145   my $or = join '|', @name;
 146   my $regexp = qr/(?:$or)/;
 147
 148   # Set the input record separator.
 149   # Note: this makes it impractical to print line numbers.
 150   $/ = '"';
 151
 152   my $found_match = 0;
 153  FILE:
 154   foreach my $file (@ARGV)
 155     {
 156       open FH, '<', $file
 157         or (warn "$ME: can't open '$file' for reading: $!\n"),
 158           $err = EXIT_ERROR, next;
 159       while (defined (my $line = <FH>))
 160         {
 161           # Skip non-matching lines early to save time
 162           $line =~ /\bif\b/
 163             or next;
 164           while ($line =~
 165               /\b(if\s*\(\s*([^)]+?)(?:\s*!=\s*([^)]+?))?\s*\)
 166               #  1          2                  3
 167                (?:   \s*$regexp\s*\((?:\s*\([^)]+\))?\s*([^)]+)\)\s*;|
 168                 \s*\{\s*$regexp\s*\((?:\s*\([^)]+\))?\s*([^)]+)\)\s*;\s*\}))/sxg)
 169             {
 170               my $all = $1;
 171               my ($lhs, $rhs) = ($2, $3);
 172               my ($free_opnd, $braced_free_opnd) = ($4, $5);
 173               my $non_NULL;
 174               if (!defined $rhs) { $non_NULL = $lhs }
 175               elsif (is_NULL $rhs) { $non_NULL = $lhs }
 176               elsif (is_NULL $lhs) { $non_NULL = $rhs }
 177               else { next }
 178
 179               # Compare the non-NULL part of the "if" expression and the
 180               # free'd expression, without regard to white space.
 181               $non_NULL =~ tr/ \t//d;
 182               my $e2 = defined $free_opnd ? $free_opnd : $braced_free_opnd;
 183               $e2 =~ tr/ \t//d;
 184               if ($non_NULL eq $e2)
 185                 {
 186                   $found_match = 1;
 187                   $list
 188                     and (print "$file\0"), next FILE;
 189                   print "$file: $all\n";
 190                 }
 191             }
 192         }
 193     }
 194   continue
 195     {
 196       close FH;
 197     }
 198
 199   $found_match && $err == EXIT_NO_MATCH
 200     and $err = EXIT_MATCH;
 201
 202   exit $err;
 203 }
 204
 205 my $foo = <<'EOF';
 206 # The above is to *find* them.
 207 # This adjusts them, removing the unnecessary "if (p)" part.
 208
 209 # FIXME: do something like this as an option (doesn't do braces):
 210 free=xfree
 211 git grep -l -z "$free *(" \
 212   | xargs -0 useless-if-before-free -l --name="$free" \
 213   | xargs -0 perl -0x3b -pi -e \
 214    's/\bif\s*\(\s*(\S+?)(?:\s*!=\s*(?:0|NULL))?\s*\)\s+('"$free"'\s*\((?:\s*\([^)]+\))?\s*\1\s*\)\s*;)/$2/s'
 215
 216 # Use the following to remove redundant uses of kfree inside braces.
 217 # Note that -0777 puts perl in slurp-whole-file mode;
 218 # but we have plenty of memory, these days...
 219 free=kfree
 220 git grep -l -z "$free *(" \
 221   | xargs -0 useless-if-before-free -l --name="$free" \
 222   | xargs -0 perl -0777 -pi -e \
 223      's/\bif\s*\(\s*(\S+?)(?:\s*!=\s*(?:0|NULL))?\s*\)\s*\{\s*('"$free"'\s*\((?:\s*\([^)]+\))?\s*\1\s*\);)\s*\}[^\n]*$/$2/gms'
 224
 225 Be careful that the result of the above transformation is valid.
 226 If the matched string is followed by "else", then obviously, it won't be.
 227
 228 When modifying files, refuse to process anything other than a regular file.
 229 EOF
 230
 231 ## Local Variables:
 232 ## mode: perl
 233 ## indent-tabs-mode: nil
 234 ## eval: (add-hook 'before-save-hook 'time-stamp)
 235 ## time-stamp-line-limit: 50
 236 ## time-stamp-start: "my $VERSION = '"
 237 ## time-stamp-format: "%:y-%02m-%02d %02H:%02M"
 238 ## time-stamp-time-zone: "UTC0"
 239 ## time-stamp-end: "'; # UTC"
 240 ## End: