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.
36eval 'exec perl -wSx "$0" "$@"'
37     if 0;
38
39my $VERSION = '2018-03-07 03:47'; # 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
45use strict;
46use warnings;
47use Getopt::Long;
48
49(my $ME = $0) =~ s|.*/||;
50
51# use File::Coda; # https://meyering.net/code/Coda/
52END {
53  defined fileno STDOUT or return;
54  close STDOUT and return;
55  warn "$ME: failed to close standard output: $!\n";
56  $? ||= 1;
57}
58
59sub 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;
70Usage: $ME [OPTIONS] FILE...
71
72Detect 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
74the semantics of the C code in FILE.  Use --name=FOO --name=BAR to also
75detect free-like functions named FOO and BAR.
76
77OPTIONS:
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
86Exit status:
87
88  0   one or more matches
89  1   no match
90  2   an error
91
92EXAMPLE:
93
94For example, this command prints all removable "if" tests before "free"
95and "kfree" calls in the linux kernel sources:
96
97    git ls-files -z |xargs -0 $ME --name=kfree
98
99EOF
100    }
101  exit $exit_code;
102}
103
104sub 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
191my $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):
196free=xfree
197git 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...
205free=kfree
206git 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
211Be careful that the result of the above transformation is valid.
212If the matched string is followed by "else", then obviously, it won't be.
213
214When modifying files, refuse to process anything other than a regular file.
215EOF
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:
227