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, write to the Free Software
  19 #  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20 #
  21 #  Author: Morten Welinder <terra@gnome.org>
  22
  23 use strict;
  24
  25 my $exitcode = 0;
  26 my $verbose = 0;
  27 my $strict = 0;
  28
  29 warn "$0: should be run from top-level directory.\n"
  30     unless -r "configure.ac" && -r 'ChangeLog';
  31
  32 my %base_exceptions =
  33     ();
  34
  35 my %exceptions =
  36     ();
  37
  38 {
  39     local (*FIND);
  40     open (*FIND, "find . '(' -type f -name '*.c' -print ')' -o '(' -type d '(' -name intl -o -name macros -o -name .git -o -name win32 ')' -prune ')' |")
  41         or die "$0: cannot execute find: $!\n";
  42   FILE:
  43     foreach my $filename (<FIND>) {
  44         chomp $filename;
  45         $filename =~ s|^\./||;
  46
  47         next if $exceptions{$filename};
  48         my $basename = $filename;
  49         $basename =~ s|^.*/||;
  50         next if $base_exceptions{$basename};
  51
  52         my %is_an_object_type = ();
  53         my $err = &pass1 ($filename, \%is_an_object_type);
  54         if ($err) {
  55             $exitcode = 1;
  56             next FILE;
  57         }
  58         $exitcode ||= &pass2 ($filename, \%is_an_object_type);
  59     }
  60     close (*FIND);
  61 }
  62
  63 exit $exitcode;
  64
  65 # -----------------------------------------------------------------------------
  66
  67 sub slurp {
  68     my ($s) = @_;
  69
  70     while ($s =~ m{(/\*|//)}) {
  71         if ($1 eq '//') {
  72             $s =~ s{//.*}{};
  73         } else {
  74             ($s =~ s{/\*.*\*/}{}) or ($s =~ s{/\*.*}{});
  75         }
  76     }
  77
  78     $s =~ s/\s+$//;
  79     return $s;
  80 }
  81
  82 # -----------------------------------------------------------------------------
  83
  84 sub pass1 {
  85     my ($filename,$pis_an_object_type) = @_;
  86
  87     local (*FIL);
  88     if (open (*FIL, "<$filename")) {
  89         while (<FIL>) {
  90             if (/^(([a-zA-Z_]+[a-zA-Z_0-9]*)_get_type)\s*\(/) {
  91                 $pis_an_object_type->{$2} = 1;
  92             }
  93             if (/\(GClassInitFunc\)\s*(([a-zA-Z_]+[a-zA-Z_0-9]*)_class_init)\s*,/) {
  94                 $pis_an_object_type->{$2} = 1;
  95             }
  96             if (/\(GInstanceInitFunc\)\s*(([a-zA-Z_]+[a-zA-Z_0-9]*)_init)\s*,/) {
  97                 $pis_an_object_type->{$2} = 1;
  98             }
  99             if (/\bG_DEFINE(_ABSTRACT)?_TYPE\b/) {
 100                 while (!/\)\s*;?\s*$/) { chomp; $_ .= &slurp (scalar <FIL>); }
 101                 if (/\bG_DEFINE(_ABSTRACT)?_TYPE\s*\([^,]*,\s*([a-zA-Z_]+[a-zA-Z_0-9]*)\s*,/) {
 102                     $pis_an_object_type->{$2} = 1;
 103                 }
 104             }
 105
 106             if (/\bBONOBO_TYPE_FUNC_FULL\b/) {
 107                 while (!/\)\s*;?\s*$/) { chomp; $_ .= &slurp (scalar <FIL>); }
 108                 if (/\bBONOBO_TYPE_FUNC_FULL\s*\([^,]*,[^,]*,[^,]*,\s*([a-zA-Z_]+[a-zA-Z_0-9]*)\s*\)/) {
 109                     $pis_an_object_type->{$1} = 1;
 110                 }
 111             }
 112
 113             if (/\bGNOME_CLASS_BOILERPLATE\b/) {
 114                 while (!/\)\s*;?\s*$/) { chomp; $_ .= &slurp (scalar <FIL>); }
 115                 if (/\bGNOME_CLASS_BOILERPLATE\s*\([^,]*,\s*([a-zA-Z_]+[a-zA-Z_0-9]*)\s*,[^,]*,[^,]*\)/) {
 116                     $pis_an_object_type->{$1} = 1;
 117                 }
 118             }
 119
 120             if (/\bGSF_CLASS(_ABSTRACT)?\b/) {
 121                 # print "$filename: $_";
 122                 while (!/\)\s*;?\s*$/) { chomp; $_ .= &slurp (scalar <FIL>); }
 123                 if (/\bGSF_CLASS(_ABSTRACT)?\s*\([^,]*,\s*([a-zA-Z_]+[a-zA-Z_0-9]*)\s*,[^,]*,[^,]*,[^,]*\)/) {
 124                     $pis_an_object_type->{$2} = 1;
 125                 }
 126             }
 127         }
 128         close (*FIL);
 129         return 0;
 130     } else {
 131         print STDERR "$0: Cannot read `$filename': $!\b";
 132         return 1;
 133     }
 134 }
 135
 136 # -----------------------------------------------------------------------------
 137
 138 sub pass2 {
 139     my ($filename,$pis_an_object_type) = @_;
 140
 141     local (*FIL);
 142     if (open (*FIL, "<$filename")) {
 143         # print "Checking $filename...\n";
 144         my $lineno = 0;
 145         my $state = 1;
 146         my $funcname = undef;
 147         my $type = undef;
 148         my $handler = undef;
 149       LINE:
 150         while (<FIL>) {
 151             $lineno++;
 152
 153             if ($state == 1 && /^(([a-zA-Z_]+[a-zA-Z_0-9]*)_(finalize|destroy|dispose|unrealize))\s*\([^,]+\)/) {
 154                 $funcname = $1;
 155                 $type = $2;
 156                 $handler = $3;
 157                 if (!$pis_an_object_type->{$type}) {
 158                     # print "NO TYPE: $type\n";
 159                     next LINE;
 160                 }
 161                 $state = 2;
 162                 next;
 163             }
 164
 165             next if $state == 1;
 166
 167             if (/^\}/) {
 168                 if ($state != 3) {
 169                     print "$filename:$lineno: apparently missing chain in $funcname.\n";
 170                 }
 171                 $state = 1;
 172                 next;
 173             }
 174
 175             if (/->\s*$handler\s*\)?\s*\(/ ||
 176                 /GNOME_CALL_PARENT.*,\s*$handler\s*,/ ||
 177                 (/gnm_command_$handler/ && $funcname =~ /^cmd_/) ||
 178                 /g_object_dtor\s*\)?\s*\(/) {
 179                 $state = 3;
 180                 next;
 181             }
 182         }
 183         close (*FIL);
 184         return 0;
 185     } else {
 186         print STDERR "$0: Cannot read `$filename': $!\b";
 187         return 1;
 188     }
 189 }
 190
 191 # -----------------------------------------------------------------------------