This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
devel/scanprov: Comments, white-space
[perl5.git] / dist / Devel-PPPort / devel / scanprov
CommitLineData
adfe19db
MHM
1#!/usr/bin/perl -w
2################################################################################
3#
4# scanprov -- scan Perl headers for provided macros
5#
6################################################################################
7#
b2049988 8# Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
adfe19db
MHM
9# Version 2.x, Copyright (C) 2001, Paul Marquess.
10# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
11#
12# This program is free software; you can redistribute it and/or
13# modify it under the same terms as Perl itself.
14#
15################################################################################
16
17use strict;
49ef49fe
CBW
18use Getopt::Long;
19
3d7c117d 20require './parts/ppptools.pl';
55179e46 21require './parts/inc/inctools';
adfe19db 22
49ef49fe
CBW
23our %opt = (
24 mode => 'check',
25 install => '/tmp/perl/install/default',
26 blead => 'bleadperl',
27);
28
29GetOptions(\%opt, qw( install=s mode=s blead=s )) or die;
30
31my $write = $opt{mode} eq 'write';
adfe19db
MHM
32
33my %embed = map { ( $_->{name} => 1 ) }
679ad62d 34 parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc ));
adfe19db 35
c48f5549
KW
36# @provided is set to the elements that are provided, but not functions in the
37# .fnc files
adfe19db
MHM
38my @provided = grep { !exists $embed{$_} }
39 map { /^(\w+)/ ? $1 : () }
40 `$^X ppport.h --list-provided`;
41
adfe19db
MHM
42my @perls = sort { $b->{version} <=> $a->{version} }
43 map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } }
49ef49fe 44 ($opt{blead}, glob "$opt{install}/*/bin/perl5.*");
adfe19db
MHM
45
46for (1 .. $#perls) {
47 $perls[$_]{todo} = $perls[$_-1]{version};
48}
49
c48f5549 50# Get rid of blead
adfe19db
MHM
51shift @perls;
52
53my %v;
54
c48f5549
KW
55# We look in descending order of perl versions. Each time through the loop
56# @provided is narrowed.
adfe19db 57for my $p (@perls) {
a745474a 58 print "checking perl $p->{version}...\n";
c48f5549
KW
59
60 # Get the hdr files associated with this version
adfe19db
MHM
61 my $archlib = `$p->{path} -MConfig -l -e 'print \$Config{archlib}'`;
62 chomp $archlib;
63 local @ARGV = glob "$archlib/CORE/*.h";
64 my %sym;
c48f5549
KW
65
66 # %sym's keys are every single \w+ that occurs in all the headers,
67 # regardless of if they are in a comment, or what.
adfe19db 68 while (<>) { $sym{$_}++ for /(\w+)/g; }
c48f5549
KW
69
70 # @provided is narrowed to include only those \w+ things that are mentioned
71 # in some hdr in this release. (If it isn't even mentioned, it won't exist in
72 # the release.) For those not mentioned, a key is added of the \w+ in %v.
73 # It is a subkey of this release's "todo" release, which is the next higher
74 # one. If we are at version n, we have already done version n+1 and the
75 # provided element was mentioned there, and now it no longer is. We take
76 # that to mean that to mean that the element became provided for in n+1.
77 # (khw notes that it could have just been in a comment for a bunch of
78 # releases above this, like
79 # /* Oh how I wish we had FOO */
80 # and at some point FOO got added. The method here is, hence, just a
81 # heuristic.
82 @provided = map { $sym{$_} or $v{$p->{todo}}{$_}++;
83 $sym{$_} ? $_ : ()
84 } @provided;
adfe19db
MHM
85}
86
c48f5549
KW
87# Read in the parts/base files. The hash ref has keys being all symbols found
88# in all the files in base/, and the values being the perl versions each symbol
89# became defined in.
adfe19db 90my $out = 'parts/base';
a745474a 91my $todo = parse_todo($out);
adfe19db 92
c48f5549
KW
93# Now add the results from above. At this point, The keys of %v are the 7
94# digit BCD version numbers, and their subkeys are the symbols provided by
95# D:P that are first mentioned in this version, like this:
96# '5009002' => {
97# 'MY_CXT_CLONE' => 1,
98# 'SV_NOSTEAL' => 1,
99# 'UTF8_MAXBYTES' => 1
100# },
101
adfe19db 102for my $v (keys %v) {
c48f5549
KW
103
104 # @new becomes the symbols for version $v not already in the file for $v
105 my @new = sort dictionary_order grep { !exists $todo->{$_} }
106 keys %{$v{$v}};
107 @new or next; # Nothing new, skip writing
108
adfe19db
MHM
109 my $file = $v;
110 $file =~ s/\.//g;
111 $file = "$out/$file";
112 -e $file or die "non-existent: $file\n";
a745474a 113 print "-- $file --\n";
49ef49fe 114 $write and (open F, ">>$file" or die "$file: $!\n");
a745474a
MHM
115 for (@new) {
116 print "adding $_\n";
49ef49fe 117 $write and printf F "%-30s # added by $0\n", $_;
a745474a 118 }
49ef49fe 119 $write and close F;
adfe19db 120}