Commit | Line | Data |
---|---|---|
adfe19db MHM |
1 | #!/usr/bin/perl -w |
2 | ################################################################################ | |
3 | # | |
40f4ec07 KW |
4 | # scanprov -- scan Perl headers for provided macros, and add known |
5 | # exceptions, and functions we weren't able to otherwise find. | |
6 | # Thus the purpose of this file has been expanded beyond what its | |
7 | # name says. | |
adfe19db | 8 | # |
daa565d0 KW |
9 | # The lines added have a code to signify they are added by us: |
10 | # M means it is a macro | |
11 | # X means it is a known exceptional item | |
40f4ec07 KW |
12 | # F means it is a function in embed.fnc that the normal routines didn't find |
13 | # | |
14 | # The regeneration routines do not know the prototypes for the macros scanned | |
15 | # for, which is gotten from documentation in the source. (If they were | |
16 | # documented, they would be put in parts/apidoc.fnc, and test cases generated | |
17 | # for them in mktodo.pl). Therefore these are all undocumented. It would be | |
18 | # best if people would add document to them in the perl source, and then this | |
19 | # portion of this function would be minimized. | |
a7971112 | 20 | # |
adfe19db MHM |
21 | ################################################################################ |
22 | # | |
b2049988 | 23 | # Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. |
adfe19db MHM |
24 | # Version 2.x, Copyright (C) 2001, Paul Marquess. |
25 | # Version 1.x, Copyright (C) 1999, Kenneth Albanowski. | |
26 | # | |
27 | # This program is free software; you can redistribute it and/or | |
28 | # modify it under the same terms as Perl itself. | |
29 | # | |
30 | ################################################################################ | |
31 | ||
32 | use strict; | |
49ef49fe CBW |
33 | use Getopt::Long; |
34 | ||
3d7c117d | 35 | require './parts/ppptools.pl'; |
55179e46 | 36 | require './parts/inc/inctools'; |
97b9d11f | 37 | require './devel/devtools.pl'; |
adfe19db | 38 | |
49ef49fe CBW |
39 | our %opt = ( |
40 | mode => 'check', | |
41 | install => '/tmp/perl/install/default', | |
42 | blead => 'bleadperl', | |
97b9d11f KW |
43 | debug => 0, |
44 | 'debug-start' => "", | |
49ef49fe CBW |
45 | ); |
46 | ||
0f50f756 | 47 | GetOptions(\%opt, qw( install=s mode=s blead=s debug=i debug-start=s)) or die; |
49ef49fe CBW |
48 | |
49 | my $write = $opt{mode} eq 'write'; | |
adfe19db | 50 | |
40f4ec07 KW |
51 | # Get the list of known macros. Functions are calculated separately below |
52 | my %embed = map { $_->{flags}{m} ? ( $_->{name} => 1 ) : () } | |
53 | parse_embed(qw(parts/embed.fnc parts/apidoc.fnc)); | |
adfe19db | 54 | |
40f4ec07 KW |
55 | # @provided is set to everthing provided |
56 | my @provided = map { /^(\w+)/ ? $1 : () } `$^X ppport.h --list-provided`; | |
adfe19db | 57 | |
daa565d0 KW |
58 | # There are a few exceptions that have to be dealt with specially. Add these |
59 | # to the list of things to scan for. | |
60 | my $hard_to_test_ref = known_but_hard_to_test_for(); | |
61 | push @provided, keys %$hard_to_test_ref; | |
62 | ||
63 | my $base_dir = 'parts/base'; | |
64 | my $todo_dir = 'parts/todo'; | |
65 | ||
66 | if ($write) { | |
67 | ||
68 | # Get the list of files, which are returned sorted, and so the min version | |
69 | # is in the 0th element | |
70 | my @files = all_files_in_dir($base_dir); | |
71 | my $file = $files[0]; | |
72 | my $min_perl = $file; | |
73 | $min_perl =~ s,.*/,,; # The name is the integer of __MIN_PERL__ | |
74 | ||
75 | # There are a very few special cases that we may not find in scanning, but | |
76 | # exist all the way back. Add them now to avoid throwing later things | |
77 | # off. | |
78 | print "-- $file --\n"; | |
79 | open F, ">>$file" or die "$file: $!\n"; | |
80 | for (qw(RETVAL CALL THIS)) { # These are also in hard_to_test_for(), | |
81 | # so can't be in blead, as they are skipped | |
82 | # in testing, so no real need to check that | |
83 | # they aren't dups. | |
84 | print "Adding $_ to $file\n"; | |
85 | print F format_output_line($_, 'X'); | |
86 | } | |
87 | close F; | |
88 | ||
89 | # Now we're going to add the hard to test symbols. The hash has been | |
90 | # manually populated and commited, with the version number ppport supports | |
91 | # them to. | |
92 | # | |
93 | # This is a hash ref with the keys being all symbols found in all the | |
94 | # files in the directory, and the values being the perl versions of each | |
95 | # symbol. | |
96 | my $todo = parse_todo($todo_dir); | |
adfe19db | 97 | |
daa565d0 KW |
98 | # The keys of $hard_to_test_ref are the symbols, and the values are |
99 | # subhashes, with each 'version' key being its proper perl version. | |
100 | # Below, we invert %hard_to_test, so that the keys are the version, and | |
101 | # the values are the symbols that go in that version | |
102 | my %add_by_version; | |
103 | for my $hard (keys %$hard_to_test_ref) { | |
104 | ||
105 | # But if someone ups the min version we support, we don't want to add | |
106 | # something less than that. | |
107 | my $version = int_parse_version($hard_to_test_ref->{$hard}); | |
108 | $version = $min_perl if $version < $min_perl; | |
109 | $version = format_version_line($version); | |
110 | ||
111 | push @{$add_by_version{$version}}, $hard | |
112 | unless grep { $todo->{$_}->{version} eq $hard } keys %$todo; | |
113 | } | |
114 | ||
115 | # Only a few files will have exceptions that apply to them. Rewrite each | |
116 | foreach my $version (keys %add_by_version) { | |
117 | my $file = "$todo_dir/" . int_parse_version($version); | |
118 | print "-- Adding known exceptions to $file --\n"; | |
119 | my $need_version_line = ! -e $file; | |
120 | open F, ">>$file" or die "$file: $!\n"; | |
121 | print F format_version_line($version) . "\n" if $need_version_line; | |
122 | foreach my $symbol (sort dictionary_order @{$add_by_version{$version}}) | |
123 | { | |
124 | print "adding $symbol\n"; | |
125 | print F format_output_line($symbol, 'X'); | |
126 | } | |
127 | close F; | |
128 | } | |
129 | } | |
130 | ||
131 | # Now that we've added the exceptions to a few files, we can parse | |
132 | # and deal with all of them. | |
133 | my $perls_ref = get_and_sort_perls(\%opt); | |
97b9d11f KW |
134 | |
135 | die "Couldn't find any perls" unless @$perls_ref > 1; | |
adfe19db | 136 | |
a3c49949 KW |
137 | find_first_mentions($perls_ref, # perls to look in |
138 | \@provided, # List of symbol names to look for | |
139 | '*.h', # Look in all hdrs. | |
140 | 1, # Strip comments | |
141 | 'M' | |
142 | ); | |
502d9f8e | 143 | |
40f4ec07 KW |
144 | # Now look for functions that we didn't test in mktodo.pl, generally because |
145 | # these were hidden behind #ifdef's. | |
146 | my $base_ref = parse_todo($base_dir); | |
147 | my @functions = parse_embed(qw(parts/embed.fnc)); | |
148 | @functions = grep { exists $_->{flags}{A} } @functions; | |
149 | # The ones we don't have info on are the ones in embed.fnc that aren't in the | |
150 | # base files. Certain of these will only be in the Perl_foo form. | |
151 | my @missing = map { exists $base_ref->{$_->{name}} | |
152 | ? () | |
153 | : ((exists $_->{flags}{p} && exists $_->{flags}{o}) | |
154 | ? ((exists $base_ref->{$_->{"Perl_$_->{name}"}} | |
155 | ? () | |
156 | : "Perl_$_->{name}")) | |
157 | : $_->{name}) | |
158 | } @functions; | |
159 | ||
160 | # These symbols will be found in the autogen'd files, and they may be | |
161 | # commented out in them. | |
162 | find_first_mentions($perls_ref, | |
163 | \@missing, | |
164 | [ 'embed.h', 'proto.h' ], | |
165 | 0, # Don't strip comments | |
166 | 'F' | |
167 | ); | |
168 | ||
502d9f8e KW |
169 | sub format_output_line |
170 | { | |
171 | my $sym = shift; | |
a7971112 | 172 | my $code = shift; |
502d9f8e | 173 | |
a7971112 | 174 | return sprintf "%-30s # $code added by $0\n", $sym; |
502d9f8e | 175 | } |
a3c49949 KW |
176 | |
177 | sub find_first_mentions | |
178 | { | |
179 | my $perls_ref = shift; # List of perls to look in | |
180 | my $look_for_ref = shift; # List of symbol names to look for | |
181 | my $hdrs = shift; # Glob of hdrs to look in | |
182 | my $strip_comments = shift; | |
183 | my $code = shift; # Mark entries as having this type | |
184 | ||
185 | $hdrs = [ $hdrs ] unless ref $hdrs; | |
186 | ||
187 | my @remaining = @$look_for_ref; | |
188 | ||
189 | my %v; | |
190 | ||
191 | # We look in descending order of perl versions. Each time through the | |
192 | # loop @remaining is narrowed. | |
193 | for my $p (@$perls_ref) { | |
194 | print "checking perl $p->{version}...\n"; | |
195 | ||
196 | # Get the hdr files associated with this version | |
197 | my $archlib = `$p->{path} -MConfig -l -e 'print \$Config{archlib}'`; | |
198 | chomp $archlib; | |
199 | local @ARGV; | |
200 | push @ARGV, glob "$archlib/CORE/$_" for @$hdrs; | |
201 | ||
202 | my %sym; | |
203 | ||
204 | # %sym's keys are every single thing that looks like an identifier | |
205 | # (beginning with a non-digit \w, followed by \w*) that occurs in all | |
206 | # the headers, regardless of where (outside of comments). | |
207 | local $/ = undef; | |
208 | while (<>) { # Read in the next file | |
209 | ||
210 | # Strip comments, from perl faq | |
211 | if ($strip_comments) { | |
212 | s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#defined $2 ? $2 : ""#gse; | |
213 | } | |
214 | ||
215 | $sym{$_}++ for /(\b[^\W\d]\w*)/g; | |
216 | } | |
217 | ||
218 | # @remaining is narrowed to include only those identifier-like things | |
40f4ec07 KW |
219 | # that are mentioned in one of the input hdrs in this release. (If it |
220 | # isn't even mentioned, it won't exist in the release.) For those not | |
221 | # mentioned, a key is added of the identifier-like thing in %v. It is | |
222 | # a subkey of this release's "todo" release, which is the next higher | |
223 | # one. If we are at version n, we have already done version n+1 and | |
224 | # the provided element was mentioned there, and now it no longer is. | |
225 | # We take that to mean that to mean that the element became provided | |
226 | # for in n+1. | |
a3c49949 KW |
227 | @remaining = map { $sym{$_} or $v{$p->{todo}}{$_}++; |
228 | $sym{$_} ? $_ : () | |
229 | } @remaining; | |
230 | ||
231 | } | |
232 | ||
233 | $v{$perls_ref->[-1]{file}}{$_}++ for @remaining; | |
234 | ||
235 | # Read in the parts/base files. The hash ref has keys being all symbols | |
236 | # found in all the files in base/, which are all we are concerned with | |
237 | # became defined in. | |
238 | my $base_ref = parse_todo($base_dir); | |
239 | ||
240 | ||
241 | # Now add the results from above. At this point, The keys of %v are the 7 | |
242 | # digit BCD version numbers, and their subkeys are the symbols provided by | |
243 | # D:P that are first mentioned in this version, like this: | |
244 | # '5009002' => { | |
245 | # 'MY_CXT_CLONE' => 1, | |
246 | # 'SV_NOSTEAL' => 1, | |
247 | # 'UTF8_MAXBYTES' => 1 | |
248 | # }, | |
249 | ||
250 | for my $v (keys %v) { | |
251 | ||
252 | # Things listed in blead (the most recent file) are special. They are | |
253 | # there by default because we haven't found them anywhere, so they | |
254 | # don't really exist as far as we can determine, so shouldn't be | |
255 | # listed as existing. | |
256 | next if $v > $perls_ref->[0]->{file}; | |
257 | ||
258 | # @new becomes the symbols for version $v not already in the file for | |
259 | # $v | |
260 | my @new = sort dictionary_order grep { !exists $base_ref->{$_} } | |
261 | keys %{$v{$v}}; | |
262 | @new or next; # Nothing new, skip writing | |
263 | ||
264 | my $file = $v; | |
265 | $file =~ s/\.//g; | |
266 | $file = "$base_dir/$file"; | |
267 | -e $file or die "non-existent: $file\n"; | |
268 | print "-- $file --\n"; | |
269 | $write and (open F, ">>$file" or die "$file: $!\n"); | |
270 | for (@new) { | |
271 | print "adding $_\n"; | |
272 | $write and print F format_output_line($_, $code); | |
273 | } | |
274 | $write and close F; | |
275 | } | |
276 | } |