s4-torture: Improve torture test boilerplate, use torture_assert()
[kai/samba.git] / source4 / script / minimal_includes.pl
1 #!/usr/bin/perl -w
2 # find a list of #include lines in C code that might not be needed
3 # usually called with something like this:
4 #    minimal_includes.pl `find . -name "*.c"`
5 # Andrew Tridgell <tridge@samba.org>
6
7 use strict;
8 use Data::Dumper;
9 use Getopt::Long;
10
11 my $opt_help = 0;
12 my $opt_remove = 0;
13 my $opt_skip_system = 0;
14 my $opt_waf = 0;
15
16 #####################################################################
17 # write a string into a file
18 sub FileSave($$)
19 {
20     my($filename) = shift;
21     my($v) = shift;
22     local(*FILE);
23     open(FILE, ">$filename") || die "can't open $filename";    
24     print FILE $v;
25     close(FILE);
26 }
27
28 sub load_lines($)
29 {
30         my $fname = shift;
31         my @lines = split(/^/m, `cat $fname`);
32         return @lines;
33 }
34
35 sub save_lines($$)
36 {
37         my $fname = shift;
38         my $lines = shift;
39         my $data = join('', @{$lines});
40         FileSave($fname, $data);
41 }
42
43 sub test_compile($)
44 {
45         my $fname = shift;
46         my $obj;
47         if ($opt_waf) {
48                 my $ret = `../buildtools/bin/waf $fname 2>&1`;
49                 return $ret
50         }
51         if ($fname =~ s/(.*)\..*$/$1.o/) {
52                 $obj = "$1.o";
53         } else {
54                 return "NOT A C FILE";
55         }
56         unlink($obj);
57         my $ret = `make $obj 2>&1`;
58         if (!unlink("$obj")) {
59                 return "COMPILE FAILED";
60         }
61         return $ret;
62 }
63
64 sub test_include($$$$)
65 {
66         my $fname = shift;
67         my $lines = shift;
68         my $i = shift;
69         my $original = shift;
70         my $line = $lines->[$i];
71         my $testfname;
72
73         $lines->[$i] = "";
74
75         my $mname = $fname . ".misaved";
76
77         unlink($mname);
78         rename($fname, $mname) || die "failed to rename $fname";
79         save_lines($fname, $lines);
80         
81         my $out = test_compile($fname);
82
83         if ($out eq $original) {
84                 if ($opt_remove) {
85                         if ($opt_skip_system && 
86                             $line =~ /system\//) {
87                                 print "$fname: not removing system include $line\n";
88                         } else {
89                                 print "$fname: removing $line\n";
90                                 unlink($mname);
91                                 return;
92                         }
93                 } else {
94                         print "$fname: might be able to remove $line\n";
95                 }
96         }
97
98         $lines->[$i] = $line;
99         rename($mname, $fname) || die "failed to restore $fname";
100 }
101
102 sub process_file($)
103 {
104         my $fname = shift;
105         my @lines = load_lines($fname);
106         my $num_lines = $#lines;
107
108         my $original = test_compile($fname);
109
110         if ($original eq "COMPILE FAILED") {
111                 print "Failed to compile $fname\n";
112                 return;
113         }
114
115         print "Processing $fname (with $num_lines lines)\n";
116         
117         my $if_level = 0;
118
119         for (my $i=0;$i<=$num_lines;$i++) {
120                 my $line = $lines[$i];
121                 if ($line =~ /^\#\s*if/) {
122                         $if_level++;
123                 }
124                 if ($line =~ /^\#\s*endif/) {
125                         $if_level--;
126                 }
127                 if ($if_level == 0 &&
128                     $line =~ /^\#\s*include/ && 
129                     !($line =~ /needed/)) {
130                         test_include($fname, \@lines, $i, $original);
131                 }
132         }
133 }
134
135
136 #########################################
137 # display help text
138 sub ShowHelp()
139 {
140     print "
141            minimise includes
142            Copyright (C) tridge\@samba.org
143
144            Usage: minimal_includes.pl [options] <C files....>
145            
146            Options:
147                  --help         show help
148                  --remove       remove includes, don't just list them
149                  --skip-system  don't remove system/ includes
150                  --waf          use waf target conventions
151 ";
152 }
153
154
155 # main program
156 GetOptions (
157             'h|help|?' => \$opt_help,
158             'remove' => \$opt_remove,
159             'skip-system' => \$opt_skip_system,
160             'waf' => \$opt_waf,
161             );
162
163 if ($opt_help) {
164         ShowHelp();
165         exit(0);
166 }
167
168 for (my $i=0;$i<=$#ARGV;$i++) {
169         my $fname = $ARGV[$i];
170         process_file($fname);
171 }