A slightly better layout for the diagram.
[p5sagit/p5-mst-13.2.git] / Porting / findrfuncs
CommitLineData
1fb76a46 1#!/usr/bin/perl -ws
bb304ec8 2
3#
4# findrfuncs: find reentrant variants of functions used in an executable.
1fb76a46 5#
bb304ec8 6# Requires a functional "nm -u". Searches headers in /usr/include
7# to find available *_r functions and looks for non-reentrant
8# variants used in the supplied executable.
9#
1fb76a46 10# Requires debug info in the shared libraries/executables.
11#
bb304ec8 12# Gurusamy Sarathy
13# gsar@ActiveState.com
14#
15# Hacked to automatically find the executable and shared objects.
16# --jhi
17
18use strict;
19use File::Find;
20
21my @EXES;
22my $NMU = 'nm -u';
23my @INCDIRS = qw(/usr/include);
24my $SO = 'so';
25my $EXE = '';
26
27if (open(CONFIG, "config.sh")) {
28 local $/;
29 my $CONFIG = <CONFIG>;
30 $SO = $1 if $CONFIG =~ /^so='(\w+)'/m;
31 $EXE = $1 if $CONFIG =~ /^_exe='\.(\w+)'/m;
c8688140 32 close(CONFIG);
bb304ec8 33}
34
35push @EXES, "perl$EXE";
36
72108f2b 37find(sub {push @EXES, $File::Find::name if /\.$SO$/}, '.' );
bb304ec8 38
39push @EXES, @ARGV;
40
41if ($^O eq 'dec_osf') {
42 $NMU = 'nm -Bu';
c8688140 43} elsif ($^O eq 'irix') {
44 $NMU = 'nm -pu';
bb304ec8 45}
46
47my %rfuncs;
48my @syms;
49find(sub {
50 return unless -f $File::Find::name;
72108f2b 51 local *F;
52 open F, "<$File::Find::name"
bb304ec8 53 or die "Can't open $File::Find::name: $!";
54 my $line;
72108f2b 55 while (defined ($line = <F>)) {
bb304ec8 56 if ($line =~ /\b(\w+_r)\b/) {
57 #warn "$1 => $File::Find::name\n";
c8688140 58 $rfuncs{$1}->{$File::Find::name}++;
bb304ec8 59 }
60 }
72108f2b 61 close F;
bb304ec8 62 }, @INCDIRS);
63
64# delete bogus symbols grepped out of comments and such
65delete $rfuncs{setlocale_r} if $^O eq 'linux';
66
b4e83e5b 67# delete obsolete (as promised by man pages) symbols
205a1031 68my $netdb_r_obsolete;
b4e83e5b 69if ($^O eq 'hpux') {
70 delete $rfuncs{crypt_r};
10bc17b6 71 delete $rfuncs{drand48_r};
efa45b01 72 delete $rfuncs{endgrent_r};
73 delete $rfuncs{endpwent_r};
10bc17b6 74 delete $rfuncs{getgrent_r};
75 delete $rfuncs{getpwent_r};
b4e83e5b 76 delete $rfuncs{setlocale_r};
10bc17b6 77 delete $rfuncs{srand48_r};
b4e83e5b 78 delete $rfuncs{strerror_r};
205a1031 79 $netdb_r_obsolete = 1;
b4e83e5b 80} elsif ($^O eq 'dec_osf') {
81 delete $rfuncs{crypt_r};
82 delete $rfuncs{strerror_r};
205a1031 83 $netdb_r_obsolete = 1;
84}
85if ($netdb_r_obsolete) {
86 delete @rfuncs{qw(endhostent_r
87 endnetent_r
88 endprotoent_r
89 endservent_r
90 gethostbyaddr_r
91 gethostbyname_r
92 gethostent_r
93 getnetbyaddr_r
94 getnetbyname_r
95 getnetent_r
205a1031 96 getprotobyname_r
10bc17b6 97 getprotobynumber_r
205a1031 98 getprotoent_r
99 getservbyname_r
100 getservbyport_r
101 getservent_r
102 sethostent_r
103 setnetent_r
104 setprotoent_r
105 setservent_r)};
b4e83e5b 106}
107
6c03d0f3 108my %syms;
109
bb304ec8 110for my $exe (@EXES) {
c8688140 111 # warn "#--- $exe\n";
1fb76a46 112 for my $sym (`$NMU $exe 2>/dev/null`) {
bb304ec8 113 chomp $sym;
bb304ec8 114 $sym =~ s/^\s+//;
c8688140 115 $sym =~ s/^([0-9A-Fa-f]+\s+)?[Uu]\s+//;
72108f2b 116 $sym =~ s/\s+[Uu]\s+-$//;
d05aa135 117 next if $sym =~ /\s/;
bb304ec8 118 $sym =~ s/\@.*\z//; # remove @@GLIBC_2.0 etc
119 # warn "#### $sym\n";
6c03d0f3 120 if (exists $rfuncs{"${sym}_r"} && ! $syms{"$sym:$exe"}++) {
bb304ec8 121 push @syms, $sym;
122 }
123 }
124
125 if (@syms) {
126 print "\nFollowing symbols in $exe have reentrant versions:\n";
127 for my $sym (@syms) {
c8688140 128 my @f = sort keys %{$rfuncs{$sym . '_r'}};
129 print "$sym => $sym" . "_r (@f)\n";
bb304ec8 130 }
131 }
132 @syms = ();
133}