3 # Try opening libperl.a with nm, and verifying it has the kind of
4 # symbols we expect, and no symbols we should avoid.
6 # Fail softly, expect things only on known platforms:
7 # - linux, x86 only (ppc linux has odd symbol tables)
8 # - darwin (OS X), both x86 and ppc
10 # and on other platforms, and if things seem odd, just give up (skip_all).
12 # Also, if the rarely-used builds options -DPERL_GLOBAL_STRUCT or
13 # -DPERL_GLOBAL_STRUCT_PRIVATE are used, verify that they did what
14 # they were meant to do, hide the global variables (see perlguts for
17 # Debugging tip: nm output (this script's input) can be faked by
18 # giving one command line argument for this script: it should be
19 # either the filename to read, or "-" for STDIN. You can also append
20 # "@style" (where style is a supported nm style, like "gnu" or "darwin")
21 # to this filename for "cross-parsing".
24 # - "text" symbols are code
25 # - "data" symbols are data (duh), with subdivisions:
26 # - "bss": (Block-Started-by-Symbol: originally from IBM assembler...),
27 # uninitialized data, which often even doesn't exist in the object
28 # file as such, only its size does, which is then created on demand
30 # - "const": initialized read-only data, like string literals
31 # - "common": uninitialized data unless initialized...
32 # (the full story is too long for here, see "man nm")
33 # - "data": initialized read-write data
34 # (somewhat confusingly below: "data data", but it makes code simpler)
35 # - "undefined": external symbol referred to by an object,
36 # most likely a text symbol. Can be either a symbol defined by
37 # a Perl object file but referred to by other Perl object files,
38 # or a completely external symbol from libc, or other system libraries.
50 if ($Config{cc} =~ /g\+\+/) {
51 # XXX Could use c++filt, maybe.
57 for my $f (qw(../libperl.a libperl.a)) {
64 unless (defined $libperl_a) {
65 skip_all "no libperl.a";
68 print "# \$^O = $^O\n";
69 print "# \$Config{archname} = $Config{archname}\n";
70 print "# \$Config{cc} = $Config{cc}\n";
71 print "# libperl = $libperl_a\n";
77 my $nm_err_tmp = "libperl$$";
80 # this is still executed when we skip_all above, avoid a warning
81 unlink $nm_err_tmp if $nm_err_tmp;
88 $fake_input = shift @ARGV;
89 print "# Faking nm output from $fake_input\n";
90 if ($fake_input =~ s/\@(.+)$//) {
92 print "# Faking nm style from $fake_style\n";
93 if ($fake_style eq 'gnu' ||
94 $fake_style eq 'linux' ||
95 $fake_style eq 'freebsd') {
97 } elsif ($fake_style eq 'darwin' || $fake_style eq 'osx') {
100 die "$0: Unknown explicit nm style '$fake_style'\n";
105 unless (defined $nm_style) {
106 if ($^O eq 'linux') {
107 # The 'gnu' style could be equally well be called 'bsd' style,
108 # since the output format of the GNU binutils nm is really BSD.
110 } elsif ($^O eq 'freebsd') {
112 } elsif ($^O eq 'darwin') {
113 $nm_style = 'darwin';
117 if (defined $nm_style) {
118 if ($nm_style eq 'gnu') {
120 } elsif ($nm_style eq 'darwin') {
122 # With the -m option we get better information than the BSD-like
123 # default: with the default, a lot of symbols get dumped into 'S'
124 # or 's', for example one cannot tell the difference between const
125 # and non-const data symbols.
128 die "$0: Unexpected nm style '$nm_style'\n";
132 if ($^O eq 'linux' && $Config{archname} !~ /^x86/) {
133 # For example in ppc most (but not all!) code symbols are placed
134 # in 'D' (data), not in ' T '. We cannot work under such conditions.
135 skip_all "linux but archname $Config{archname} not x86*";
138 unless (defined $nm) {
142 unless (defined $nm_style) {
143 skip_all "no nm style";
146 print "# nm = $nm\n";
147 print "# nm_style = $nm_style\n";
148 print "# nm_opt = $nm_opt\n";
151 skip_all "no executable nm $nm";
154 if ($nm_style eq 'gnu' && !defined $fake_style) {
155 open(my $gnu_verify, "$nm --version|") or
156 skip_all "nm failed: $!";
158 while (<$gnu_verify>) {
164 unless ($gnu_verified) {
165 skip_all "no GNU nm";
169 if (defined $fake_input) {
170 if ($fake_input eq '-') {
171 open($nm_fh, "<&STDIN") or
172 skip_all "Duping STDIN failed: $!";
174 open($nm_fh, "<", $fake_input) or
175 skip_all "Opening '$fake_input' failed: $!";
177 undef $nm_err_tmp; # In this case there will be no nm errors.
179 open($nm_fh, "$nm $nm_opt $libperl_a 2>$nm_err_tmp |") or
180 skip_all "$nm $nm_opt $libperl_a failed: $!";
183 sub is_perlish_symbol {
184 $_[0] =~ /^(?:PL_|Perl|PerlIO)/;
187 # XXX Implement "internal test" for this script (option -t?)
188 # to verify that the parsing does what it's intended to.
193 if (m{^(\w+\.o):$}) {
195 $symbols->{obj}{$1}++;
199 die "$0: undefined current object: $line"
200 unless defined $symbols->{o};
201 # 64-bit systems have 16 hexdigits, 32-bit systems have 8.
202 if (s/^[0-9a-f]{8}(?:[0-9a-f]{8})? //) {
203 if (/^[Rr] (\w+)$/) {
204 # R: read only (const)
205 $symbols->{data}{const}{$1}{$symbols->{o}}++;
207 # Skip local const (read only).
208 } elsif (/^[Tti] (\w+)(\..+)?$/) {
209 $symbols->{text}{$1}{$symbols->{o}}++;
210 } elsif (/^C (\w+)$/) {
211 $symbols->{data}{common}{$1}{$symbols->{o}}++;
212 } elsif (/^[BbSs] (\w+)(\.\d+)?$/) {
213 # Bb: uninitialized data (bss)
214 # Ss: uninitialized data "for small objects"
215 $symbols->{data}{bss}{$1}{$symbols->{o}}++;
216 } elsif (/^D _LIB_VERSION$/) {
217 # Skip the _LIB_VERSION (not ours, probably libm)
218 } elsif (/^[DdGg] (\w+)$/) {
219 # Dd: initialized data
220 # Gg: initialized "for small objects"
221 $symbols->{data}{data}{$1}{$symbols->{o}}++;
222 } elsif (/^. \.?(\w+)$/) {
223 # Skip the unknown types.
224 print "# Unknown type: $line ($symbols->{o})\n";
227 } elsif (/^ {8}(?: {8})? U _?(\w+)$/) {
229 return if is_perlish_symbol($symbol);
230 $symbols->{undef}{$symbol}{$symbols->{o}}++;
234 print "# Unexpected nm output '$line' ($symbols->{o})\n";
237 sub nm_parse_darwin {
240 if (m{^(?:.+)?libperl\.a\((\w+\.o)\):$}) {
242 $symbols->{obj}{$1}++;
246 die "$0: undefined current object: $line" unless defined $symbols->{o};
247 # 64-bit systems have 16 hexdigits, 32-bit systems have 8.
248 if (s/^[0-9a-f]{8}(?:[0-9a-f]{8})? //) {
249 # String literals can live in different sections
250 # depending on the compiler and os release, assumedly
252 if (/^\(__TEXT,__(?:const|cstring|literal\d+)\) (?:non-)?external _?(\w+)(\.\w+)?$/) {
253 my ($symbol, $suffix) = ($1, $2);
254 # Ignore function-local constants like
255 # _Perl_av_extend_guts.oom_array_extend
256 return if defined $suffix && /__TEXT,__const/;
257 # Ignore the cstring unnamed strings.
258 return if $symbol =~ /^L\.str\d+$/;
259 $symbols->{data}{const}{$symbol}{$symbols->{o}}++;
260 } elsif (/^\(__TEXT,__text\) (?:non-)?external _(\w+)$/) {
261 $symbols->{text}{$1}{$symbols->{o}}++;
262 } elsif (/^\(__DATA,__\w*?(const|data|bss|common)\w*\) (?:non-)?external _?(\w+)(\.\w+)?$/) {
263 my ($dtype, $symbol, $suffix) = ($1, $2, $3);
264 # Ignore function-local constants like
265 # _Perl_pp_gmtime.dayname
266 return if defined $suffix;
267 $symbols->{data}{$dtype}{$symbol}{$symbols->{o}}++;
268 } elsif (/^\(__DATA,__const\) non-external _\.memset_pattern\d*$/) {
269 # Skip this, whatever it is (some inlined leakage from
271 } elsif (/^\(__TEXT,__eh_frame/) {
272 # Skip the eh_frame (exception handling) symbols.
274 } elsif (/^\(__\w+,__\w+\) /) {
275 # Skip the unknown types.
276 print "# Unknown type: $line ($symbols->{o})\n";
279 } elsif (/^ {8}(?: {8})? \(undefined(?: \[lazy bound\])?\) external _?(.+)/) {
280 # darwin/ppc marks most undefined text symbols
283 return if is_perlish_symbol($symbol);
284 $symbols->{undef}{$symbol}{$symbols->{o}}++;
288 print "# Unexpected nm output '$line' ($symbols->{o})\n";
293 if ($nm_style eq 'gnu') {
294 $nm_parse = \&nm_parse_gnu;
295 } elsif ($nm_style eq 'darwin') {
296 $nm_parse = \&nm_parse_darwin;
299 unless (defined $nm_parse) {
300 skip_all "no nm parser ($nm_style $nm_style, \$^O $^O)";
308 $nm_parse->(\%symbols);
311 # use Data::Dumper; print Dumper(\%symbols);
313 # Something went awfully wrong. Wrong nm? Wrong options?
314 unless (keys %symbols) {
315 skip_all "no symbols\n";
317 unless (exists $symbols{text}) {
318 skip_all "no text symbols\n";
321 # These should always be true for everyone.
323 ok($symbols{obj}{'pp.o'}, "has object pp.o");
324 ok($symbols{text}{'Perl_peep'}, "has text Perl_peep");
325 ok($symbols{text}{'Perl_pp_uc'}{'pp.o'}, "has text Perl_pp_uc in pp.o");
326 ok(exists $symbols{data}{const}, "has data const symbols");
327 ok($symbols{data}{const}{PL_no_mem}{'globals.o'}, "has PL_no_mem");
329 my $DEBUGGING = $Config{ccflags} =~ /-DDEBUGGING/ ? 1 : 0;
331 my $GS = $Config{ccflags} =~ /-DPERL_GLOBAL_STRUCT\b/ ? 1 : 0;
332 my $GSP = $Config{ccflags} =~ /-DPERL_GLOBAL_STRUCT_PRIVATE/ ? 1 : 0;
334 print "# GS = $GS\n";
335 print "# GSP = $GSP\n";
339 for my $dtype (sort keys %{$symbols{data}}) {
340 for my $symbol (sort keys %{$symbols{data}{$dtype}}) {
341 $data_symbols{$symbol}++;
345 # The following tests differ between vanilla vs $GSP or $GS.
348 print "# -DPERL_GLOBAL_STRUCT_PRIVATE\n";
349 ok(!exists $data_symbols{PL_hash_seed}, "has no PL_hash_seed");
350 ok(!exists $data_symbols{PL_ppaddr}, "has no PL_ppaddr");
352 ok(! exists $symbols{data}{bss}, "has no data bss symbols");
353 ok(! exists $symbols{data}{data} ||
354 # clang with ASAN seems to add this symbol to every object file:
355 !grep($_ ne '__unnamed_1', keys %{$symbols{data}{data}}),
356 "has no data data symbols");
357 ok(! exists $symbols{data}{common}, "has no data common symbols");
359 # -DPERL_GLOBAL_STRUCT_PRIVATE should NOT have
360 # the extra text symbol for accessing the vars
361 # (as opposed to "just" -DPERL_GLOBAL_STRUCT)
362 ok(! exists $symbols{text}{Perl_GetVars}, "has no Perl_GetVars");
364 print "# -DPERL_GLOBAL_STRUCT\n";
365 ok(!exists $data_symbols{PL_hash_seed}, "has no PL_hash_seed");
366 ok(!exists $data_symbols{PL_ppaddr}, "has no PL_ppaddr");
368 ok(! exists $symbols{data}{bss}, "has no data bss symbols");
370 # These PerlIO data symbols are left visible with
371 # -DPERL_GLOBAL_STRUCT (as opposed to -DPERL_GLOBAL_STRUCT_PRIVATE)
385 # PL_magic_vtables is const with -DPERL_GLOBAL_STRUCT_PRIVATE but
386 # otherwise not const -- because of SWIG which wants to modify
387 # the table. Evil SWIG, eeevil.
389 # my_cxt_index is used with PERL_IMPLICIT_CONTEXT, which
390 # -DPERL_GLOBAL_STRUCT has turned on.
391 eq_array([sort keys %{$symbols{data}{data}}],
396 "data data symbols");
398 # Only one data common symbol, our "supervariable".
399 eq_array([sort keys %{$symbols{data}{common}}],
401 "data common symbols");
403 ok($symbols{data}{data}{PL_VarsPtr}{'globals.o'}, "has PL_VarsPtr");
404 ok($symbols{data}{common}{PL_Vars}{'globals.o'}, "has PL_Vars");
406 # -DPERL_GLOBAL_STRUCT has extra text symbol for accessing the vars.
407 ok($symbols{text}{Perl_GetVars}{'util.o'}, "has Perl_GetVars");
409 print "# neither -DPERL_GLOBAL_STRUCT nor -DPERL_GLOBAL_STRUCT_PRIVATE\n";
411 if ( !$symbols{data}{common} ) {
412 # This is likely because Perl was compiled with
413 # -Accflags="-fno-common"
414 $symbols{data}{common} = $symbols{data}{bss};
417 ok($symbols{data}{common}{PL_hash_seed}{'globals.o'}, "has PL_hash_seed");
418 ok($symbols{data}{data}{PL_ppaddr}{'globals.o'}, "has PL_ppaddr");
420 # None of the GLOBAL_STRUCT* business here.
421 ok(! exists $symbols{data}{data}{PL_VarsPtr}, "has no PL_VarsPtr");
422 ok(! exists $symbols{data}{common}{PL_Vars}, "has no PL_Vars");
423 ok(! exists $symbols{text}{Perl_GetVars}, "has no Perl_GetVars");
426 # See the comments in the beginning for what "undefined symbols"
427 # really means. We *should* have many of those, that is a good thing.
428 ok(keys %{$symbols{undef}}, "has undefined symbols");
430 # There are certain symbols we expect to see.
432 # chmod, socket, getenv, sigaction, exp, time are system/library
433 # calls that should each see at least one use. exp can be expl
436 chmod => undef, # There is no Configure symbol for chmod.
437 socket => 'd_socket',
438 getenv => undef, # There is no Configure symbol for getenv,
439 sigaction => 'd_sigaction',
443 if ($Config{uselongdouble} && $Config{longdblsize} > $Config{doublesize}) {
444 if ($Config{usequadmath}) {
445 $expected{expq} = undef; # There is no Configure symbol for expq.
447 $expected{expl} = undef; # There is no Configure symbol for expl.
450 $expected{exp} = undef; # There is no Configure symbol for exp.
453 # DynaLoader will use dlopen, unless we are building static,
454 # and it is used in the platforms we are supporting in this test.
455 if ($Config{usedl} ) {
456 $expected{dlopen} = 'd_dlopen';
459 for my $symbol (sort keys %expected) {
460 if (defined $expected{$symbol} && !$Config{$expected{$symbol}}) {
466 my @o = exists $symbols{undef}{$symbol} ?
467 sort keys %{ $symbols{undef}{$symbol} } : ();
468 ok(@o, "uses $symbol (@o)");
471 # There are certain symbols we expect NOT to see.
473 # gets is horribly unsafe.
475 # fgets should not be used (Perl has its own API, sv_gets),
476 # even without perlio.
480 # strcat, strcpy, strncat, strncpy are unsafe.
482 # sprintf and vsprintf should not be used because
483 # Perl has its own safer and more portable implementations.
484 # (One exception: for certain floating point outputs
485 # the native sprintf is still used in some platforms, see below.)
487 # atoi has unsafe and undefined failure modes, and is affected by locale.
488 # Its cousins include atol and atoll.
490 # strtol and strtoul are affected by locale.
491 # Cousins include strtoq.
493 # system should not be used, use pp_system or my_popen.
498 for my $str (qw(system)) {
499 $unexpected{$str} = "d_$str";
502 for my $stdio (qw(gets fgets tmpfile sprintf vsprintf)) {
503 $unexpected{$stdio} = undef; # No Configure symbol for these.
505 for my $str (qw(strcat strcpy strncat strncpy)) {
506 $unexpected{$str} = undef; # No Configure symbol for these.
509 $unexpected{atoi} = undef; # No Configure symbol for atoi.
510 $unexpected{atol} = undef; # No Configure symbol for atol.
512 for my $str (qw(atoll strtol strtoul strtoq)) {
513 $unexpected{$str} = "d_$str";
516 for my $symbol (sort keys %unexpected) {
517 if (defined $unexpected{$symbol} && !$Config{$unexpected{$symbol}}) {
523 my @o = exists $symbols{undef}{$symbol} ?
524 sort keys %{ $symbols{undef}{$symbol} } : ();
525 # While sprintf() is bad in the general case,
526 # some platforms implement Gconvert via sprintf, in sv.o.
527 if ($symbol eq 'sprintf' &&
528 $Config{d_Gconvert} =~ /^sprintf/ &&
529 @o == 1 && $o[0] eq 'sv.o') {
531 skip("uses sprintf for Gconvert in sv.o");
534 is(@o, 0, "uses no $symbol (@o)");
538 if (defined $nm_err_tmp) {
539 if (open(my $nm_err_fh, $nm_err_tmp)) {
541 while (<$nm_err_fh>) {
542 # OS X has weird error where nm warns about
543 # "no name list" but then outputs fine.
544 if (/nm: no name list/ && $^O eq 'darwin') {
545 print "# $^O ignoring $nm output: $_";
548 warn "$0: Unexpected $nm error: $_";
551 die "$0: Unexpected $nm errors\n" if $error;
553 warn "Failed to open '$nm_err_tmp': $!\n";