Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

executable file 388 lines (297 sloc) 10.816 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387
#!/usr/bin/perl

=head1 NAME

xs-coverage - show XS coverage

=head1 SYNOPSIS

xs-coverage [OPTION]... xs.so libfoo...

-i, --ignore FILE list of symbols to ignore
-x, --xs MODULE=PREFIX... demangle maps for XS functions (champlain_*, unique_*)
-p, --prefix PREFIX... undefined symbol prefixes
-v, --verbose enable verbose mode
-nm use nm for extracting symbols instead of readelf
--help print this help message

Where I<xs.so> is the path to an XS library and I<libfoo> is the name of a
dynamic shared library to which the XS library is linked.

Examples:

Finding the symbol coverage in the XS module Champlain which provides the
bindings for both lichamplain.so (Champlain::* champlain_*) and
libchamplain-gtk.so (Gtk2::Champlain* gtk_champlain_*).

xs-coverage blib/arch/auto/Champlain/Champlain.so libchamplain --xs Gtk2=gtk --prefix champlain gtk

Although in the last command the options I<--xs Gtk2=gtk> can be removed as the
application already maps the namespace I<Gtk2> to the prefix I<gtk>. Thus, the
previous example could be simply written as:

xs-coverage blib/arch/auto/Champlain/Champlain.so libchamplain --prefix champlain gtk

Finding the symbol coverage in the module Gtk2::Unique (Gtk2::Unique* unique_*):

xs-coverage blib/arch/auto/Gtk2/Unique/Unique.so libunique --xs Gtk2::Unique=unique --ignore .xs-coverage.ignore

Finding the symbol coverage in the module Gtk2::SourceView2 (Gtk2::SourceView2* gtk_source_*):

xs-coverage blib/arch/auto/Gtk2/SourceView2/SourceView2.so libgtksourceview-2 -xs Gtk2::SourceView2=gtk_source

In the previous example the namespace I<Gtk2> is mapped to the empty prefix.
This causes the symbol I<XS_Gtk2__UniqueBackend_get_screen> to be renamed to
I<unique_backend_get_screen>.

=head1 DESCRIPTION

This program displays the symbols that are defined in the given libraries and
that are not covered in the given XS module. The uncovered symbols are found
through different heuristics.

The symbols covered by the XS bindings are found by looking at the actual XS
functions exported by the XS shared library (XS functions) and by looking at the
symbols that are undefined (XS external calls).

The dynamically shared libraries referenced by the XS library are inspected in
order to see which symbols they export. Only shared libraries whose names match
the given names are inspected.

The symbols exported by the dynamically linked libraries and the XS library are
compared (both the XS functions and the external calls made by the XS code).

It's possible to provide a file that contains a list of symbols to ignore. In
that case these symbols will not be reported by the program.

=head2 XS symbols

The program will always load the XS symbols (example:
I<XS_Champlain__MapSource_get_y>). These function namess are then demangled and
converted to their original C function name. The demanangling operates only on
functions that start with the prefix I<XS_>. The module name is then transformed
to a proper C prefix by using the XS conversion rules provided through the
command line and the camel case names are replaced by underscore names.

The conversion algorithm can be affected by providing various mapping prefixes
through the flag I<--xs>. For instance, to map the function
I<XS_Gtk2__ChamplainEmbed_get_view> into I<gtk_champlain_embed_get_view> the
mapping prefix I<--xs Gtk2=gtk> has to be provided.

It is also possible to remove a prefix from a C function by simply removing the
prefix part from the command line mapping. For instance, to change
I<XS_Gtk2__UniqueApp_send_message> to I<unique_app_send_message> simply use the
mapping -I<--xs Gtk2=>

=head2 Undefined symbols

If the parameter prefix is used then the program will load all undefined symbols
in the library that match the given prefixes and assumed that they are
references to function calls.

For finding all functions that start with the prefix I<unique> simply add the
argument I<--prefix unique>

=head1 CAVEATS

This program can't detect XS functions that are aliased.

=cut

use strict;
use warnings;

use Getopt::Long qw(:config auto_help);
use Pod::Usage;
use Data::Dumper;

my $USE_READELF = 1;
my $VERBOSE = 0;

exit main();

sub main {

# Argument parsing
my $ignore;
my $maps = {};
my @xs_undefined;
GetOptions(
'ignore|i=s' => \$ignore,
'xs|x=s%' => \$maps,
'prefix|p=s{,}' => \@xs_undefined,
'verbose|v' => \$VERBOSE,
'nm' => sub { $USE_READELF = 0 },
) or pod2usage(1);
pod2usage(1) unless @ARGV >= 2;
my ($xs, @names) = @ARGV;

$maps->{Gtk2} = 'gtk' unless exists $maps->{Gtk2};


# Find the full paths of the libraries to process
my @libs = get_library_dependencies($xs, @names);
warn "No dependency matches @names for $xs\n" unless @libs;

# Symbols to ignore
my %ignore;
if (defined $ignore) {
foreach my $symbol (slurp($ignore)) {
chomp $symbol;
$ignore{$symbol} = 1;
}
}


# The symbols exported by the C libraries
my %symbols = ();
foreach my $lib (@libs) {
foreach my $symbol (get_so_symbols($lib)) {
next if $ignore{$symbol};
$symbols{$symbol} = 1;
}
}


# Remove all symbols that have a binding
foreach my $symbol (get_xs_defined_symbols($xs, $maps)) {
delete $symbols{$symbol};
}
if (@xs_undefined) {
foreach my $symbol (get_xs_undefined_symbols($xs, @xs_undefined)) {
delete $symbols{$symbol};
}
}

# Show all symbols that are missing coverage
foreach my $symbol (sort keys %symbols) {
print $symbol, "\n";
}

return 0;
}


#
# Get the defined symbols from an XS library. This function keeps only the
# symbols that start with "XS_". The symbol names are demangled back to their C
# names.
#
# $maps is used for transforming the Perl module name into a C prefix. If a
# module name can't be found in the map then its lower case version will be
# used instead.
#
sub get_xs_defined_symbols {
my ($file, $maps) = @_;

my $regexp_maps = join '|',
map { quotemeta($_) }
sort { length($b) <=> length($a) || $a cmp $b }
keys %{ $maps }
;
$regexp_maps = qr/$regexp_maps/;

my @symbols;
foreach my $xs_symbol (get_so_symbols($file)) {

# XS_Gtk2__SourceView2__PrintCompositor_set_tab_width -> prefix=Gtk2__SourceView2__PrintCompositor, method=set_tab_width
my ($prefix, $method) = ($xs_symbol =~ /^XS_([^_]+(?:__(?:[^_]+))+)_(.*)$/) or next;

# Get the Perl module name
my $module = $prefix;
$module =~ s/__/::/g;

# Apply the proper mappings to the module names so that a Perl module name
# gets mangled to the correct C prefix.
#
# Ex: maps = {Gtk2::SourceView2 => 'gtk_source'}
# Gtk2::SourceView2::PrintCompositor -> gtk_source_PrintCompositor
# In this example 'PrintCompositor' will be mangled correctly later.
if ($module =~ /^($regexp_maps)(.*)$/) {
my ($match, $rest) = ($1, $2);
$rest =~ s/::/_/;
$prefix = $maps->{$match} . $rest;
}

# Convert ZoomLevel -> zoom_level
$prefix =~ s/(.)([A-Z])/$1 . '_' . lc($2)/ge;
$prefix =~ s/^([A-Z])/lc($1)/e;

$prefix =~ s/__/_/g;
$prefix = lc $prefix;

# Construct the symbol name
my $symbol = "${prefix}_${method}";
push @symbols, $symbol;
}

return @symbols;
}


#
# Get the symbols undefined by an XS library. This function keeps only the
# symbols that start the given prefixes.
#
# The unused symbols are expexted to be refered because the bindings are using them.
#
sub get_xs_undefined_symbols {
my ($file, @prefixes) = @_;

my $match = @prefixes ? make_starts_with_regexp(@prefixes) : undef;

my @symbols = ();
foreach my $symbol (get_symbols(undefined => $file)) {
if ($match) {
push @symbols, $symbol if $symbol =~ /$match/;
}
else {
push @symbols, $symbol;
}
}

return @symbols;
}


#
# Returns the symbols defined in the given C library.
#
sub get_so_symbols {
my ($file) = @_;
return get_symbols(defined => $file);
}


#
# Returns the symbols defined in the given C library.
#
sub get_symbols {
return $USE_READELF ? get_symbols_readelf(@_) : get_symbols_nm(@_);
}


#
# Returns the symbols defined in the given C library by using the program 'nm'.
#
sub get_symbols_nm {
my ($type, $file) = @_;

my $args = $type eq 'defined' ? '--defined-only --extern-only' : '--undefined-only';

my $command = "nm $args --format posix $file";
print "$command\n" if $VERBOSE;
open my $handle, "$command|" or die "Can't read symbols from $file: $!";
my @symbols = ();
while (my $line = <$handle>) {
chomp $line;
my ($function) = split / /, $line, 2;
push @symbols, $function;
}
close $handle;
return @symbols;
}


#
# Returns the symbols defined in the given C library by using the program
# 'readelf'.
#
sub get_symbols_readelf {
my ($type, $file) = @_;

# type: \d+ -> defined, UND -> undefined
my $wanted = $type eq 'defined' ? qr/\d+/ : qr/UND/;

# 105: 00008980 650 FUNC GLOBAL DEFAULT 11 XS_Gtk2__UniqueMessageData_get_workspace
my $regexp = qr{
^
\s+ \d+: \s+ [\da-f]+ \s+ \d+ # 105: 00008980 650
\s+ FUNC \s+ GLOBAL \s+ DEFAULT # FUNC GLOBAL DEFAULT
\s+ $wanted # type
\s+ ( \w+ ) # the function name
\s*
$
}x;

my $command = "readelf -W -s $file";
print "$command\n" if $VERBOSE;
open my $handle, "$command|" or die "Can't read symbols from $file: $!";
my @symbols;
my %seen;
while (my $line = <$handle>) {
my ($function) = ($line =~ /$regexp/) or next;
next if $seen{$function};

$seen{$function} = 1;
push @symbols, $function;
}
close $handle;

return @symbols;
}


#
# Inspects a shared library through ldd and finds the full paths of the
# libraries that match the given names.
#
sub get_library_dependencies {
my ($file, @names) = @_;

# Match a line of output provided by ldd
# Input: " libchamplain-0.3.so.1 => /usr/lib/libchamplain-0.3.so.1 (0xb7ed2000)\n"
my $regexp = qr(
^
\s+
(\S+) # Library name
\s => \s # " => "
(\S+) # library path
)x;


# Pattern that matches only the libraries that start with the given names
my $match = make_starts_with_regexp(@names);

my $command = "ldd $file";
open my $handle, "$command|" or die "Can't read shared library dependencies from $file: $!";
my @libraries = ();
while (my $line = <$handle>) {
my ($name, $path) = ($line =~ /$regexp/) or next;
next unless $name =~ /$match/;
push @libraries, $path;
}
close $handle;

return @libraries;
}


#
# Creates a regexp that matches strings that start with the given words.
#
sub make_starts_with_regexp {
my (@words) = @_;
my $match = join '|', map { quotemeta($_) } @words;
return qr/^(?:$match)/;
}


sub slurp {
my ($filename) = @_;
open my $handle, '<', $filename or die "Can't read file $filename because $!";
local $?;
my @content = <$handle>;
close $handle;
return @content;
}
Something went wrong with that request. Please try again.