Skip to content

Commit

Permalink
t/porting/libperl.t: add better diagnostics
Browse files Browse the repository at this point in the history
If it fails to find a symbol where expected (e.g. in the text section of
the object file), then print a diagnostic message which lists all the nm
lines where the symbol *was* found (if any).

This is achieved by adding a xref hash which maps symbol names to arrays
of lines / object files.

Also document the format of the %symbols hash.
  • Loading branch information
iabyn committed Jul 31, 2024
1 parent 01f2355 commit ddf056b
Showing 1 changed file with 116 additions and 5 deletions.
121 changes: 116 additions & 5 deletions t/porting/libperl.t
Original file line number Diff line number Diff line change
Expand Up @@ -211,6 +211,14 @@ sub nm_parse_gnu {
} else {
die "$0: undefined current object: $line"
unless defined $symbols->{o};

# generate a cross-ref of every line each symbol appears on,
# for diagnostics
for my $sym (grep !/^[0-9A-Fa-f]+$/, /\b(\w{2,})\b/g) {
push @{$symbols->{xref}{$sym}},
sprintf "%20s: %s", $symbols->{o}, $line;
}

# 64-bit systems have 16 hexdigits, 32-bit systems have 8.
if (s/^[0-9a-f]{8}(?:[0-9a-f]{8})? //) {
if (/^[Rr] (\w+)$/) {
Expand Down Expand Up @@ -242,7 +250,7 @@ sub nm_parse_gnu {
return if is_perlish_symbol($symbol);
$symbols->{undef}{$symbol}{$symbols->{o}}++;
return;
}
}
}
print "# Unexpected nm output '$line' ($symbols->{o})\n";
}
Expand All @@ -258,6 +266,14 @@ sub nm_parse_darwin {
return;
} else {
die "$0: undefined current object: $line" unless defined $symbols->{o};

# generate a cross-ref of every line each symbol appears on,
# for diagnostics
for my $sym (grep !/^[0-9A-Fa-f]+$/, /\b(\w{2,})\b/g) {
push @{$symbols->{xref}{$sym}},
sprintf "%20s: %s", $symbols->{o}, $line;
}

# 64-bit systems have 16 hexdigits, 32-bit systems have 8.
if (s/^[0-9a-f]{8}(?:[0-9a-f]{8})? //) {
# String literals can live in different sections
Expand Down Expand Up @@ -328,6 +344,68 @@ while (<$nm_fh>) {

# use Data::Dumper; print Dumper(\%symbols);

# %symbols looks like:
#
# (
# # hash of seen object files
#
# 'obj' => {
# 'pp_hot.o' => 1,
# ...
# },
#
# 'data' => {
# 'bss' => {
# 'PL_current_context' => { 'globals.o' => 1 },
# ...
# },
# 'data' => {
# 'my_cxt_index' => { 'DynaLoader.o' => 1 },
# ...
# },
# 'const' => {
# 'UNI_BOPO_invlist' => { 'regcomp.o' => 1 },
# ...
# }
# },
#
# # the last seen object file name
#
# 'o' => 'DynaLoader.o',
#
# # for each symbol, which files the symbol is undefined in:
#
# 'undef' => {
# 'memcpy' => {
# 'pp.o' => 1,
# 'perl.o' => 1,
# ...
# },
# ...
# },
#
# # for each text symbol, which file(s) the symbols is defined in
# # and whether as a t or T (local or global text symbol)
#
# 'text' => {
# 'Perl_sv_nolocking' => { 'mathoms.o' => { 'T' => 1 } },
# }
#
# # cross-ref hash for diagnostics. For each symbol, list
# # every nm entry which refers to that symbol, and in which object
# # file:
#
# 'xref' => {
# 'Perl_av_fetch' => [
# ' op.o: U Perl_av_fetch',
# ' perl.o: U Perl_av_fetch',
# ' universal.o: U Perl_av_fetch',
# ' av.o: 0000000000002621 T Perl_av_fetch',
# ...
# ],
# )


# Something went awfully wrong. Wrong nm? Wrong options?
unless (keys %symbols) {
skip_all "no symbols\n";
Expand All @@ -336,12 +414,36 @@ unless (exists $symbols{text}) {
skip_all "no text symbols\n";
}

# do an ok(), but on failure, print some diagnostic info about that symbol

sub has_symbol {
my ($sym, $ok, $desc) = @_;
ok($ok, $desc);
return if $ok;
my $xref = $symbols{xref}{$sym};
if ($xref) {
diag "Didn't find the symbol '$sym' where expected,",
"but it was seen in these places in the nm output:",
@{$xref};
}
else {
diag "Didn't find the symbol '$sym' where expected,",
"nor was it seen elsewhere in the nm output";
}
}


# These should always be true for everyone.

ok($symbols{obj}{'util.o'}, "has object util.o");
ok($symbols{text}{'Perl_croak'}{'util.o'}, "has text Perl_croak in util.o");

has_symbol('Perl_croak', $symbols{text}{'Perl_croak'}{'util.o'},
"has text Perl_croak in util.o");

ok(exists $symbols{data}{const}, "has data const symbols");
ok($symbols{data}{const}{PL_no_modify}{'globals.o'}, "has PL_no_modify");

has_symbol('PL_no_modify', $symbols{data}{const}{PL_no_modify}{'globals.o'},
"has PL_no_modify");

my $nocommon = $Config{ccflags} =~ /-fno-common/ ? 1 : 0;

Expand All @@ -361,13 +463,19 @@ if ( !$symbols{data}{common} ) {
$symbols{data}{common} = $symbols{data}{bss};
}

ok($symbols{data}{common}{PL_hash_seed_w}{'globals.o'}, "has PL_hash_seed_w");
ok($symbols{data}{data}{PL_ppaddr}{'globals.o'}, "has PL_ppaddr");
has_symbol('PL_hash_seed_w',
$symbols{data}{common}{PL_hash_seed_w}{'globals.o'},
"has PL_hash_seed_w");

has_symbol('PL_ppaddr', $symbols{data}{data}{PL_ppaddr}{'globals.o'},
"has PL_ppaddr");

# See the comments in the beginning for what "undefined symbols"
# really means. We *should* have many of those, that is a good thing.
ok(keys %{$symbols{undef}}, "has undefined symbols");

# -------------------------------------------------------------------

# There are certain symbols we expect to see.

# chmod, socket, getenv, sigaction, exp, time are system/library
Expand Down Expand Up @@ -407,6 +515,9 @@ for my $symbol (sort keys %expected) {
ok(@o, "uses $symbol (@o)");
}


# -------------------------------------------------------------------

# There are certain symbols we expect NOT to see.
#
# gets is horribly unsafe.
Expand Down

0 comments on commit ddf056b

Please sign in to comment.