1#!/usr/bin/perl -w 2################################################################################ 3# 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. 8# 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 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. 20# 21################################################################################ 22# 23# Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. 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 32use strict; 33use Getopt::Long; 34 35require './parts/ppptools.pl'; 36require './parts/inc/inctools'; 37require './devel/devtools.pl'; 38 39our %opt = ( 40 mode => 'check', 41 install => '/tmp/perl/install/default', 42 blead => 'bleadperl', 43 debug => 0, 44 'debug-start' => "", 45); 46 47GetOptions(\%opt, qw( install=s mode=s blead=s debug=i debug-start=s)) or die; 48 49my $write = $opt{mode} eq 'write'; 50 51# Get the list of known macros. Functions are calculated separately below 52my %embed = map { $_->{flags}{m} ? ( $_->{name} => 1 ) : () } 53 parse_embed(qw(parts/embed.fnc parts/apidoc.fnc)); 54 55# @provided is set to everthing provided 56my @provided = map { /^(\w+)/ ? $1 : () } `$^X ppport.h --list-provided`; 57 58# There are a few exceptions that have to be dealt with specially. Add these 59# to the list of things to scan for. 60my $hard_to_test_ref = known_but_hard_to_test_for(); 61push @provided, keys %$hard_to_test_ref; 62 63my $base_dir = 'parts/base'; 64my $todo_dir = 'parts/todo'; 65 66if ($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); 97 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. 133my $perls_ref = get_and_sort_perls(\%opt); 134 135die "Couldn't find any perls" unless @$perls_ref > 1; 136 137find_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 ); 143 144# Now look for functions that we didn't test in mktodo.pl, generally because 145# these were hidden behind #ifdef's. 146my $base_ref = parse_todo($base_dir); 147my @functions = parse_embed(qw(parts/embed.fnc)); 148 149# We could just gather data for the publicly available ones, but having this 150# information available for everything is useful (for those who know where to 151# look) 152#@functions = grep { exists $_->{flags}{A} } @functions; 153 154# The ones we don't have info on are the ones in embed.fnc that aren't in the 155# base files. Certain of these will only be in the Perl_foo form. 156my @missing = map { exists $base_ref->{$_->{name}} 157 ? () 158 : ((exists $_->{flags}{p} && exists $_->{flags}{o}) 159 ? ((exists $base_ref->{$_->{"Perl_$_->{name}"}} 160 ? () 161 : "Perl_$_->{name}")) 162 : $_->{name}) 163 } @functions; 164 165# These symbols will be found in the autogen'd files, and they may be 166# commented out in them. 167find_first_mentions($perls_ref, 168 \@missing, 169 [ 'embed.h', 'proto.h' ], 170 0, # Don't strip comments 171 'F' 172 ); 173 174sub format_output_line 175{ 176 my $sym = shift; 177 my $code = shift; 178 179 return sprintf "%-30s # $code added by $0\n", $sym; 180} 181 182sub find_first_mentions 183{ 184 my $perls_ref = shift; # List of perls to look in 185 my $look_for_ref = shift; # List of symbol names to look for 186 my $hdrs = shift; # Glob of hdrs to look in 187 my $strip_comments = shift; 188 my $code = shift; # Mark entries as having this type 189 190 $hdrs = [ $hdrs ] unless ref $hdrs; 191 192 my @remaining = @$look_for_ref; 193 194 my %v; 195 196 # We look in descending order of perl versions. Each time through the 197 # loop @remaining is narrowed. 198 for my $p (@$perls_ref) { 199 print "checking perl $p->{version}...\n"; 200 201 # Get the hdr files associated with this version 202 my $archlib = `$p->{path} -MConfig -l -e 'print \$Config{archlib}'`; 203 chomp $archlib; 204 local @ARGV; 205 push @ARGV, glob "$archlib/CORE/$_" for @$hdrs; 206 207 my %sym; 208 209 # %sym's keys are every single thing that looks like an identifier 210 # (beginning with a non-digit \w, followed by \w*) that occurs in all 211 # the headers, regardless of where (outside of comments). 212 local $/ = undef; 213 while (<>) { # Read in the next file 214 215 # Strip comments, from perl faq 216 if ($strip_comments) { 217 s#/\*[^*]*\*+([^/*][^*]*\*+)*/|("(\\.|[^"\\])*"|'(\\.|[^'\\])*'|.[^/"'\\]*)#defined $2 ? $2 : ""#gse; 218 } 219 220 $sym{$_}++ for /(\b[^\W\d]\w*)/g; 221 } 222 223 # @remaining is narrowed to include only those identifier-like things 224 # that are mentioned in one of the input hdrs in this release. (If it 225 # isn't even mentioned, it won't exist in the release.) For those not 226 # mentioned, a key is added of the identifier-like thing in %v. It is 227 # a subkey of this release's "todo" release, which is the next higher 228 # one. If we are at version n, we have already done version n+1 and 229 # the provided element was mentioned there, and now it no longer is. 230 # We take that to mean that to mean that the element became provided 231 # for in n+1. 232 @remaining = map { $sym{$_} or $v{$p->{todo}}{$_}++; 233 $sym{$_} ? $_ : () 234 } @remaining; 235 236 } 237 238 $v{$perls_ref->[-1]{file}}{$_}++ for @remaining; 239 240 # Read in the parts/base files. The hash ref has keys being all symbols 241 # found in all the files in base/, which are all we are concerned with 242 # became defined in. 243 my $base_ref = parse_todo($base_dir); 244 245 246 # Now add the results from above. At this point, The keys of %v are the 7 247 # digit BCD version numbers, and their subkeys are the symbols provided by 248 # D:P that are first mentioned in this version, like this: 249 # '5009002' => { 250 # 'MY_CXT_CLONE' => 1, 251 # 'SV_NOSTEAL' => 1, 252 # 'UTF8_MAXBYTES' => 1 253 # }, 254 255 for my $v (keys %v) { 256 257 # Things listed in blead (the most recent file) are special. They are 258 # there by default because we haven't found them anywhere, so they 259 # don't really exist as far as we can determine, so shouldn't be 260 # listed as existing. 261 next if $v > $perls_ref->[0]->{file}; 262 263 # @new becomes the symbols for version $v not already in the file for 264 # $v 265 my @new = sort dictionary_order grep { !exists $base_ref->{$_} } 266 keys %{$v{$v}}; 267 @new or next; # Nothing new, skip writing 268 269 my $file = $v; 270 $file =~ s/\.//g; 271 $file = "$base_dir/$file"; 272 -e $file or die "non-existent: $file\n"; 273 print "-- $file --\n"; 274 $write and (open F, ">>$file" or die "$file: $!\n"); 275 for (@new) { 276 print "adding $_\n"; 277 $write and print F format_output_line($_, $code); 278 } 279 $write and close F; 280 } 281} 282