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-2020 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 = '2020-04-04 15:07'; # 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 use strict;
  46 use warnings;
  47 use Getopt::Long;
  48
  49 (my $ME = $0) =~ s|.*/||;
  50
  51 # use File::Coda; # https://meyering.net/code/Coda/
  52 END {
  53   defined fileno STDOUT or return;
  54   close STDOUT and return;
  55   warn "$ME: failed to close standard output: $!\n";
  56   $? ||= 1;
  57 }
  58
  59 sub usage ($)
  60 {
  61   my ($exit_code) = @_;
  62   my $STREAM = ($exit_code == 0 ? *STDOUT : *STDERR);
  63   if ($exit_code != 0)
  64     {
  65       print $STREAM "Try '$ME --help' for more information.\n";
  66     }
  67   else
  68     {
  69       print $STREAM <<EOF;
  70 Usage: $ME [OPTIONS] FILE...
  71
  72 Detect any instance in FILE of a useless "if" test before a free call, e.g.,
  73 "if (p) free (p);".  Any such test may be safely removed without affecting
  74 the semantics of the C code in FILE.  Use --name=FOO --name=BAR to also
  75 detect free-like functions named FOO and BAR.
  76
  77 OPTIONS:
  78
  79    --list       print only the name of each matching FILE (\\0-terminated)
  80    --name=N     add name N to the list of \'free\'-like functions to detect;
  81                   may be repeated
  82
  83    --help       display this help and exit
  84    --version    output version information and exit
  85
  86 Exit status:
  87
  88   0   one or more matches
  89   1   no match
  90   2   an error
  91
  92 EXAMPLE:
  93
  94 For example, this command prints all removable "if" tests before "free"
  95 and "kfree" calls in the linux kernel sources:
  96
  97     git ls-files -z |xargs -0 $ME --name=kfree
  98
  99 EOF
 100     }
 101   exit $exit_code;
 102 }
 103
 104 sub is_NULL ($)
 105 {
 106   my ($expr) = @_;
 107   return ($expr eq 'NULL' || $expr eq '0');
 108 }
 109
 110 {
 111   sub EXIT_MATCH {0}
 112   sub EXIT_NO_MATCH {1}
 113   sub EXIT_ERROR {2}
 114   my $err = EXIT_NO_MATCH;
 115
 116   my $list;
 117   my @name = qw(free);
 118   GetOptions
 119     (
 120      help => sub { usage 0 },
 121      version => sub { print "$ME version $VERSION\n"; exit },
 122      list => \$list,
 123      'name=s@' => \@name,
 124     ) or usage 1;
 125
 126   # Make sure we have the right number of non-option arguments.
 127   # Always tell the user why we fail.
 128   @ARGV < 1
 129     and (warn "$ME: missing FILE argument\n"), usage EXIT_ERROR;
 130
 131   my $or = join '|', @name;
 132   my $regexp = qr/(?:$or)/;
 133
 134   # Set the input record separator.
 135   # Note: this makes it impractical to print line numbers.
 136   $/ = '"';
 137
 138   my $found_match = 0;
 139  FILE:
 140   foreach my $file (@ARGV)
 141     {
 142       open FH, '<', $file
 143         or (warn "$ME: can't open '$file' for reading: $!\n"),
 144           $err = EXIT_ERROR, next;
 145       while (defined (my $line = <FH>))
 146         {
 147           # Skip non-matching lines early to save time
 148           $line =~ /\bif\b/
 149             or next;
 150           while ($line =~
 151               /\b(if\s*\(\s*([^)]+?)(?:\s*!=\s*([^)]+?))?\s*\)
 152               #  1          2                  3
 153                (?:   \s*$regexp\s*\((?:\s*\([^)]+\))?\s*([^)]+)\)\s*;|
 154                 \s*\{\s*$regexp\s*\((?:\s*\([^)]+\))?\s*([^)]+)\)\s*;\s*\}))/sxg)
 155             {
 156               my $all = $1;
 157               my ($lhs, $rhs) = ($2, $3);
 158               my ($free_opnd, $braced_free_opnd) = ($4, $5);
 159               my $non_NULL;
 160               if (!defined $rhs) { $non_NULL = $lhs }
 161               elsif (is_NULL $rhs) { $non_NULL = $lhs }
 162               elsif (is_NULL $lhs) { $non_NULL = $rhs }
 163               else { next }
 164
 165               # Compare the non-NULL part of the "if" expression and the
 166               # free'd expression, without regard to white space.
 167               $non_NULL =~ tr/ \t//d;
 168               my $e2 = defined $free_opnd ? $free_opnd : $braced_free_opnd;
 169               $e2 =~ tr/ \t//d;
 170               if ($non_NULL eq $e2)
 171                 {
 172                   $found_match = 1;
 173                   $list
 174                     and (print "$file\0"), next FILE;
 175                   print "$file: $all\n";
 176                 }
 177             }
 178         }
 179     }
 180   continue
 181     {
 182       close FH;
 183     }
 184
 185   $found_match && $err == EXIT_NO_MATCH
 186     and $err = EXIT_MATCH;
 187
 188   exit $err;
 189 }
 190
 191 my $foo = <<'EOF';
 192 # The above is to *find* them.
 193 # This adjusts them, removing the unnecessary "if (p)" part.
 194
 195 # FIXME: do something like this as an option (doesn't do braces):
 196 free=xfree
 197 git grep -l -z "$free *(" \
 198   | xargs -0 useless-if-before-free -l --name="$free" \
 199   | xargs -0 perl -0x3b -pi -e \
 200    's/\bif\s*\(\s*(\S+?)(?:\s*!=\s*(?:0|NULL))?\s*\)\s+('"$free"'\s*\((?:\s*\([^)]+\))?\s*\1\s*\)\s*;)/$2/s'
 201
 202 # Use the following to remove redundant uses of kfree inside braces.
 203 # Note that -0777 puts perl in slurp-whole-file mode;
 204 # but we have plenty of memory, these days...
 205 free=kfree
 206 git grep -l -z "$free *(" \
 207   | xargs -0 useless-if-before-free -l --name="$free" \
 208   | xargs -0 perl -0777 -pi -e \
 209      's/\bif\s*\(\s*(\S+?)(?:\s*!=\s*(?:0|NULL))?\s*\)\s*\{\s*('"$free"'\s*\((?:\s*\([^)]+\))?\s*\1\s*\);)\s*\}[^\n]*$/$2/gms'
 210
 211 Be careful that the result of the above transformation is valid.
 212 If the matched string is followed by "else", then obviously, it won't be.
 213
 214 When modifying files, refuse to process anything other than a regular file.
 215 EOF
 216
 217 ## Local Variables:
 218 ## mode: perl
 219 ## indent-tabs-mode: nil
 220 ## eval: (add-hook 'before-save-hook 'time-stamp)
 221 ## time-stamp-line-limit: 50
 222 ## time-stamp-start: "my $VERSION = '"
 223 ## time-stamp-format: "%:y-%02m-%02d %02H:%02M"
 224 ## time-stamp-time-zone: "UTC0"
 225 ## time-stamp-end: "'; # UTC"
 226 ## End: