~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Wine Cross Reference
wine/tools/winedump/function_grep.pl

Version: ~ [ wine-1.1.33 ] ~ [ wine-1.1.32 ] ~ [ wine-1.1.31 ] ~ [ wine-1.1.30 ] ~ [ wine-1.1.29 ] ~ [ wine-1.1.28 ] ~ [ wine-1.1.27 ] ~ [ wine-1.1.26 ] ~ [ wine-1.1.25 ] ~ [ wine-1.1.24 ] ~ [ wine-1.1.23 ] ~ [ wine-1.1.22 ] ~ [ wine-1.1.21 ] ~ [ wine-1.1.20 ] ~ [ wine-1.1.19 ] ~ [ wine-1.1.18 ] ~ [ wine-1.1.17 ] ~ [ wine-1.1.16 ] ~ [ wine-1.1.15 ] ~ [ wine-1.1.14 ] ~ [ wine-1.1.13 ] ~ [ wine-1.1.12 ] ~ [ wine-1.1.11 ] ~ [ wine-1.1.10 ] ~ [ wine-1.1.9 ] ~ [ wine-1.1.8 ] ~ [ wine-1.1.7 ] ~ [ wine-1.0.1 ] ~ [ wine-1.1.6 ] ~ [ wine-1.1.5 ] ~ [ wine-1.1.4 ] ~ [ wine-1.1.3 ] ~ [ wine-1.1.2 ] ~ [ wine-1.1.1 ] ~ [ wine-1.1.0 ] ~ [ wine-1.0 ] ~

  1 #! /usr/bin/perl -w
  2 #
  3 # Copyright 2000 Patrik Stridvall
  4 #
  5 # This library is free software; you can redistribute it and/or
  6 # modify it under the terms of the GNU Lesser General Public
  7 # License as published by the Free Software Foundation; either
  8 # version 2.1 of the License, or (at your option) any later version.
  9 #
 10 # This library is distributed in the hope that it will be useful,
 11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
 12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 13 # Lesser General Public License for more details.
 14 #
 15 # You should have received a copy of the GNU Lesser General Public
 16 # License along with this library; if not, write to the Free Software
 17 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
 18 #
 19 
 20 use strict;
 21 
 22 my $name0=$0;
 23 $name0 =~ s%^.*/%%;
 24 
 25 my $invert = 0;
 26 my $pattern;
 27 my @files = ();
 28 my $usage;
 29 
 30 while(defined($_ = shift)) {
 31     if (/^-v$/) {
 32         $invert = 1;
 33     } elsif (/^--?(\?|h|help)$/) {
 34         $usage=0;
 35     } elsif (/^-/) {
 36         print STDERR "$name0:error: unknown option '$_'\n";
 37         $usage=2;
 38         last;
 39     } elsif(!defined($pattern)) {
 40         $pattern = $_;
 41     } else {
 42         push @files, $_;
 43     }
 44 }
 45 if (defined $usage)
 46 {
 47     print "Usage: $name0 [--help] [-v] pattern files...\n";
 48     print "where:\n";
 49     print "--help    Prints this help message\n";
 50     print "-v        Return functions that do not match pattern\n";
 51     print "pattern   A regular expression for the function name\n";
 52     print "files...  A list of files to search the function in\n";
 53     exit $usage;
 54 }
 55 
 56 foreach my $file (@files) {
 57     open(IN, "< $file") || die "Error: Can't open $file: $!\n";
 58 
 59     my $level = 0;
 60     my $extern_c = 0;
 61 
 62     my $again = 0;
 63     my $lookahead = 0;
 64     while($again || defined(my $line = <IN>)) {
 65         if(!$again) {
 66             chomp $line;
 67             if($lookahead) {
 68                 $lookahead = 0;
 69                 $_ .= "\n" . $line;
 70             } else {
 71                 $_ = $line;
 72             }
 73         } else {
 74             $again = 0;
 75         }
 76 
 77         # remove C comments
 78         if(s/^(|.*?[^\/])(\/\*.*?\*\/)(.*)$/$1 $3/s) {
 79             $again = 1;
 80             next;
 81         } elsif(/^(.*?)\/\*/s) {
 82             $lookahead = 1;
 83             next;
 84         }
 85 
 86         # remove C++ comments
 87         while(s/^(.*?)\/\/.*?$/$1\n/s) { $again = 1; }
 88         if($again) { next; }
 89 
 90         # remove empty rows
 91         if(/^\s*$/) { next; }
 92 
 93         # remove preprocessor directives
 94         if(s/^\s*\#/\#/m) {
 95             if(/^\#[.\n\r]*?\\$/m) {
 96                 $lookahead = 1;
 97                 next;
 98             } elsif(s/^\#\s*(.*?)(\s+(.*?))?\s*$//m) {
 99                 next;
100             }
101         }
102 
103         # Remove extern "C"
104         if(s/^\s*extern[\s\n]+"C"[\s\n]+\{//m) {
105             $extern_c = 1;
106             $again = 1;
107             next;
108         } elsif(m/^\s*extern[\s\n]+"C"/m) {
109             $lookahead = 1;
110             next;
111         }
112 
113         if($level > 0)
114         {
115             my $line = "";
116             while(/^[^\{\}]/) {
117                 s/^([^\{\}\'\"]*)//s;
118                 $line .= $1;
119                 if(s/^\'//) {
120                     $line .= "\'";
121                     while(/^./ && !s/^\'//) {
122                         s/^([^\'\\]*)//s;
123                         $line .= $1;
124                         if(s/^\\//) {
125                             $line .= "\\";
126                             if(s/^(.)//s) {
127                                 $line .= $1;
128                                 if($1 eq "0") {
129                                     s/^(\d{0,3})//s;
130                                     $line .= $1;
131                                 }
132                             }
133                         }
134                     }
135                     $line .= "\'";
136                 } elsif(s/^\"//) {
137                     $line .= "\"";
138                     while(/^./ && !s/^\"//) {
139                         s/^([^\"\\]*)//s;
140                         $line .= $1;
141                         if(s/^\\//) {
142                             $line .= "\\";
143                             if(s/^(.)//s) {
144                                 $line .= $1;
145                                 if($1 eq "0") {
146                                     s/^(\d{0,3})//s;
147                                     $line .= $1;
148                                 }
149                             }
150                         }
151                     }
152                     $line .= "\"";
153                 }
154             }
155 
156             if(s/^\{//) {
157                 $_ = $'; $again = 1;
158                 $line .= "{";
159                 $level++;
160             } elsif(s/^\}//) {
161                 $_ = $'; $again = 1;
162                 $line .= "}" if $level > 1;
163                 $level--;
164                 if($level == -1 && $extern_c) {
165                     $extern_c = 0;
166                     $level = 0;
167                 }
168             }
169 
170             next;
171         } elsif(/^class[^\}]*{/) {
172             $_ = $'; $again = 1;
173             $level++;
174             next;
175         } elsif(/^class[^\}]*$/) {
176             $lookahead = 1;
177             next;
178         } elsif(/^typedef[^\}]*;/) {
179             next;
180         } elsif(/(extern\s+|static\s+)?
181                 (?:__inline__\s+|__inline\s+|inline\s+)?
182                 ((struct\s+|union\s+|enum\s+)?(?:\w+(?:\:\:(?:\s*operator\s*[^\)\s]+)?)?)+((\s*(?:\*|\&))+\s*|\s+))
183                 ((__cdecl|__stdcall|CDECL|VFWAPIV|VFWAPI|WINAPIV|WINAPI|CALLBACK)\s+)?
184                 ((?:\w+(?:\:\:)?)+(\(\w+\))?)\s*\(([^\)]*)\)\s*
185                 (?:\w+(?:\s*\([^\)]*\))?\s*)*\s*
186                 (\{|\;)/sx)
187         {
188             $_ = $'; $again = 1;
189             if($11 eq "{")  {
190                 $level++;
191             }
192 
193             my $linkage = $1;
194             my $return_type = $2;
195             my $calling_convention = $7;
196             my $name = $8;
197             my $arguments = $10;
198 
199             if(!defined($linkage)) {
200                 $linkage = "";
201             }
202 
203             if(!defined($calling_convention)) {
204                 $calling_convention = "";
205             }
206 
207             $linkage =~ s/\s*$//;
208 
209             $return_type =~ s/\s*$//;
210             $return_type =~ s/\s*\*\s*/*/g;
211             $return_type =~ s/(\*+)/ $1/g;
212 
213             $arguments =~ y/\t\n/  /;
214             $arguments =~ s/^\s*(.*?)\s*$/$1/;
215             if($arguments eq "") { $arguments = "void" }
216 
217             my @argument_types;
218             my @argument_names;
219             my @arguments = split(/,/, $arguments);
220             foreach my $n (0..$#arguments) {
221                 my $argument_type = "";
222                 my $argument_name = "";
223                 my $argument = $arguments[$n];
224                 $argument =~ s/^\s*(.*?)\s*$/$1/;
225                 # print "  " . ($n + 1) . ": '$argument'\n";
226                 $argument =~ s/^(IN OUT(?=\s)|IN(?=\s)|OUT(?=\s)|\s*)\s*//;
227                 $argument =~ s/^(const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s)|\s*)\s*//;
228                 if($argument =~ /^\.\.\.$/) {
229                     $argument_type = "...";
230                     $argument_name = "...";
231                 } elsif($argument =~ /^
232                         ((?:struct\s+|union\s+|enum\s+|(?:signed\s+|unsigned\s+)
233                           (?:short\s+(?=int)|long\s+(?=int))?)?(?:\w+(?:\:\:)?)+)\s*
234                         ((?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*(?:\*\s*?)*)\s*
235                         (?:const(?=\s)|CONST(?=\s)|__const(?=\s)|__restrict(?=\s))?\s*
236                         (\w*)\s*
237                         (?:\[\]|\s+OPTIONAL)?/x)
238                 {
239                     $argument_type = "$1";
240                     if($2 ne "") {
241                         $argument_type .= " $2";
242                     }
243                     $argument_name = $3;
244 
245                     $argument_type =~ s/\s*const\s*/ /;
246                     $argument_type =~ s/^\s*(.*?)\s*$/$1/;
247 
248                     $argument_name =~ s/^\s*(.*?)\s*$/$1/;
249                 } else {
250                     die "$file: $.: syntax error: '$argument'\n";
251                 }
252                 $argument_types[$n] = $argument_type;
253                 $argument_names[$n] = $argument_name;
254                 # print "  " . ($n + 1) . ": '$argument_type': '$argument_name'\n";
255             }
256             if($#argument_types == 0 && $argument_types[0] =~ /^void$/i) {
257                 $#argument_types = -1;
258                 $#argument_names = -1;
259             }
260 
261             @arguments = ();
262             foreach my $n (0..$#argument_types) {
263                 if($argument_names[$n] && $argument_names[$n] ne "...") {
264                     if($argument_types[$n] !~ /\*$/) {
265                         $arguments[$n] = $argument_types[$n] . " " . $argument_names[$n];
266                     } else {
267                         $arguments[$n] = $argument_types[$n] . $argument_names[$n];
268                     }
269                 } else {
270                     $arguments[$n] = $argument_types[$n];
271                 }
272             }
273 
274             $arguments = join(", ", @arguments);
275             if(!$arguments) { $arguments = "void"; }
276 
277             if((!$invert && $name =~ /$pattern/) || ($invert && $name !~ /$pattern/)) {
278                 if($calling_convention) {
279                     print "$return_type $calling_convention $name($arguments)\n";
280                 } else {
281                     if($return_type =~ /\*$/) {
282                         print "$return_type$name($arguments)\n";
283                     } else {
284                         print "$return_type $name($arguments)\n";
285                     }
286                 }
287             }
288         } elsif(/\'(?:[^\\\']*|\\.)*\'/s) {
289             $_ = $'; $again = 1;
290         } elsif(/\"(?:[^\\\"]*|\\.)*\"/s) {
291             $_ = $'; $again = 1;
292         } elsif(/;/s) {
293             $_ = $'; $again = 1;
294         } elsif(/extern\s+"C"\s+{/s) {
295             $_ = $'; $again = 1;
296         } elsif(/\{/s) {
297             $_ = $'; $again = 1;
298             $level++;
299         } else {
300             $lookahead = 1;
301         }
302     }
303     close(IN);
304 }

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.