tools/check-finalizers

   1 #!/usr/bin/perl -w
   2 #
   3 #  Gnumeric
   4 #
   5 #  Copyright (C) 2003 Morten Welinder.
   6 #
   7 #  This program is free software; you can redistribute it and/or
   8 #  modify it under the terms of the GNU General Public License as
   9 #  published by the Free Software Foundation; either version 2 of the
  10 #  License, or (at your option) any later version.
  11 #
  12 #  This library is distributed in the hope that it will be useful,
  13 #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 #  General Public License for more details.
  16 #
  17 #  You should have received a copy of the GNU General Public License
  18 #  along with this library; if not, see <https://www.gnu.org/licenses/>.
  19 #
  20 #  Author: Morten Welinder <terra@gnome.org>
  21
  22 use strict;
  23
  24 my $exitcode = 0;
  25 my $verbose = 0;
  26 my $strict = 0;
  27
  28 warn "$0: should be run from top-level directory.\n"
  29     unless -r "configure.ac" && -r 'ChangeLog';
  30
  31 my %base_exceptions =
  32     ();
  33
  34 my %exceptions =
  35     ();
  36
  37 {
  38     local (*FIND);
  39     open (*FIND, "find . '(' -type f -name '*.c' -print ')' -o '(' -type d '(' -name intl -o -name macros -o -name .git -o -name win32 ')' -prune ')' |")
  40         or die "$0: cannot execute find: $!\n";
  41   FILE:
  42     foreach my $filename (<FIND>) {
  43         chomp $filename;
  44         $filename =~ s|^\./||;
  45
  46         next if $exceptions{$filename};
  47         my $basename = $filename;
  48         $basename =~ s|^.*/||;
  49         next if $base_exceptions{$basename};
  50
  51         my %is_an_object_type = ();
  52         my $err = &pass1 ($filename, \%is_an_object_type);
  53         if ($err) {
  54             $exitcode = 1;
  55             next FILE;
  56         }
  57         $exitcode ||= &pass2 ($filename, \%is_an_object_type);
  58     }
  59     close (*FIND);
  60 }
  61
  62 exit $exitcode;
  63
  64 # -----------------------------------------------------------------------------
  65
  66 sub slurp {
  67     my ($s) = @_;
  68
  69     while ($s =~ m{(/\*|//)}) {
  70         if ($1 eq '//') {
  71             $s =~ s{//.*}{};
  72         } else {
  73             ($s =~ s{/\*.*\*/}{}) or ($s =~ s{/\*.*}{});
  74         }
  75     }
  76
  77     $s =~ s/\s+$//;
  78     return $s;
  79 }
  80
  81 # -----------------------------------------------------------------------------
  82
  83 sub pass1 {
  84     my ($filename,$pis_an_object_type) = @_;
  85
  86     local (*FIL);
  87     if (open (*FIL, "<$filename")) {
  88         while (<FIL>) {
  89             if (/^(([a-zA-Z_]+[a-zA-Z_0-9]*)_get_type)\s*\(/) {
  90                 $pis_an_object_type->{$2} = 1;
  91             }
  92             if (/\(GClassInitFunc\)\s*(([a-zA-Z_]+[a-zA-Z_0-9]*)_class_init)\s*,/) {
  93                 $pis_an_object_type->{$2} = 1;
  94             }
  95             if (/\(GInstanceInitFunc\)\s*(([a-zA-Z_]+[a-zA-Z_0-9]*)_init)\s*,/) {
  96                 $pis_an_object_type->{$2} = 1;
  97             }
  98             if (/\bG_DEFINE(_ABSTRACT)?_TYPE\b/) {
  99                 while (!/\)\s*;?\s*$/) { chomp; $_ .= &slurp (scalar <FIL>); }
 100                 if (/\bG_DEFINE(_ABSTRACT)?_TYPE\s*\([^,]*,\s*([a-zA-Z_]+[a-zA-Z_0-9]*)\s*,/) {
 101                     $pis_an_object_type->{$2} = 1;
 102                 }
 103             }
 104
 105             if (/\bBONOBO_TYPE_FUNC_FULL\b/) {
 106                 while (!/\)\s*;?\s*$/) { chomp; $_ .= &slurp (scalar <FIL>); }
 107                 if (/\bBONOBO_TYPE_FUNC_FULL\s*\([^,]*,[^,]*,[^,]*,\s*([a-zA-Z_]+[a-zA-Z_0-9]*)\s*\)/) {
 108                     $pis_an_object_type->{$1} = 1;
 109                 }
 110             }
 111
 112             if (/\bGNOME_CLASS_BOILERPLATE\b/) {
 113                 while (!/\)\s*;?\s*$/) { chomp; $_ .= &slurp (scalar <FIL>); }
 114                 if (/\bGNOME_CLASS_BOILERPLATE\s*\([^,]*,\s*([a-zA-Z_]+[a-zA-Z_0-9]*)\s*,[^,]*,[^,]*\)/) {
 115                     $pis_an_object_type->{$1} = 1;
 116                 }
 117             }
 118
 119             if (/\bGSF_CLASS(_ABSTRACT)?\b/) {
 120                 # print "$filename: $_";
 121                 while (!/\)\s*;?\s*$/) { chomp; $_ .= &slurp (scalar <FIL>); }
 122                 if (/\bGSF_CLASS(_ABSTRACT)?\s*\([^,]*,\s*([a-zA-Z_]+[a-zA-Z_0-9]*)\s*,[^,]*,[^,]*,[^,]*\)/) {
 123                     $pis_an_object_type->{$2} = 1;
 124                 }
 125             }
 126         }
 127         close (*FIL);
 128         return 0;
 129     } else {
 130         print STDERR "$0: Cannot read `$filename': $!\b";
 131         return 1;
 132     }
 133 }
 134
 135 # -----------------------------------------------------------------------------
 136
 137 sub pass2 {
 138     my ($filename,$pis_an_object_type) = @_;
 139
 140     local (*FIL);
 141     if (open (*FIL, "<$filename")) {
 142         # print "Checking $filename...\n";
 143         my $lineno = 0;
 144         my $state = 1;
 145         my $funcname = undef;
 146         my $type = undef;
 147         my $handler = undef;
 148       LINE:
 149         while (<FIL>) {
 150             $lineno++;
 151
 152             if ($state == 1 && /^(([a-zA-Z_]+[a-zA-Z_0-9]*)_(finalize|destroy|dispose|unrealize))\s*\([^,]+\)/) {
 153                 $funcname = $1;
 154                 $type = $2;
 155                 $handler = $3;
 156                 if (!$pis_an_object_type->{$type}) {
 157                     # print "NO TYPE: $type\n";
 158                     next LINE;
 159                 }
 160                 $state = 2;
 161                 next;
 162             }
 163
 164             next if $state == 1;
 165
 166             if (/^\}/) {
 167                 if ($state != 3) {
 168                     print "$filename:$lineno: apparently missing chain in $funcname.\n";
 169                 }
 170                 $state = 1;
 171                 next;
 172             }
 173
 174             if (/->\s*$handler\s*\)?\s*\(/ ||
 175                 /GNOME_CALL_PARENT.*,\s*$handler\s*,/ ||
 176                 (/gnm_command_$handler/ && $funcname =~ /^cmd_/) ||
 177                 /g_object_dtor\s*\)?\s*\(/) {
 178                 $state = 3;
 179                 next;
 180             }
 181         }
 182         close (*FIL);
 183         return 0;
 184     } else {
 185         print STDERR "$0: Cannot read `$filename': $!\b";
 186         return 1;
 187     }
 188 }
 189
 190 # -----------------------------------------------------------------------------