CapsuleTest.pm 8.61 KB
Newer Older
Simon McVittie's avatar
Simon McVittie committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
# Copyright © 2017 Collabora Ltd
#
# This file is part of libcapsule.
#
# libcapsule is free software: you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation; either version 2.1 of the
# License, or (at your option) any later version.
#
# libcapsule is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with libcapsule.  If not, see <http://www.gnu.org/licenses/>.
17
18
#
# Note that get_symbols_with_nm() uses some GPL-2+ code taken from dpkg.
Simon McVittie's avatar
Simon McVittie committed
19
20
21
22
23
24
25
26
27
28
29
30
31

package CapsuleTest;

use strict;
use warnings;

use Cwd qw(abs_path);
use FindBin;
use Exporter qw(import);
use IPC::Run qw(run);
use Test::More;

our @EXPORT = qw(
32
    assert_run_verbose
Simon McVittie's avatar
Simon McVittie committed
33
    diag_multiline
34
    explain_wait_status
35
    get_symbols_with_nm
Simon McVittie's avatar
Simon McVittie committed
36
37
38
    run_ok
    run_verbose
    skip_all_unless_bwrap
39
    skip_all_unless_nm
Simon McVittie's avatar
Simon McVittie committed
40
    $CAPSULE_CAPTURE_LIBS_TOOL
41
42
43
    $CAPSULE_INIT_PROJECT_TOOL
    $CAPSULE_SYMBOLS_TOOL
    $CAPSULE_VERSION_TOOL
44
    $NM
45
    $PKG_CONFIG
Simon McVittie's avatar
Simon McVittie committed
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
    $builddir
    $srcdir
);

=encoding utf8

=head1 NAME

CapsuleTest - utilities for libcapsule automated and manual tests

=head1 EXPORTED VARIABLES

=over

=cut

62
63
64
65
66
67
68
69
70
=item $PKG_CONFIG

The B<pkg-config>(1) utility.

=cut

our $PKG_CONFIG = $ENV{PKG_CONFIG};
$PKG_CONFIG = 'pkg-config' unless length $PKG_CONFIG;

Simon McVittie's avatar
Simon McVittie committed
71
72
73
74
75
76
77
78
79
80
81
82
83
=item $CAPSULE_CAPTURE_LIBS_TOOL

The B<capsule-capture-libs>(1) development tool.

=cut

our $CAPSULE_CAPTURE_LIBS_TOOL = $ENV{CAPSULE_CAPTURE_LIBS_TOOL};

if (! length $CAPSULE_CAPTURE_LIBS_TOOL) {
    $CAPSULE_CAPTURE_LIBS_TOOL = `$PKG_CONFIG --variable=CAPSULE_CAPTURE_LIBS_TOOL libcapsule-tools`;
    chomp $CAPSULE_CAPTURE_LIBS_TOOL;
}

84
85
86
87
88
89
90
91
92
=item $CAPSULE_INIT_PROJECT_TOOL

The B<capsule-init-project>(1) development tool.

=cut

our $CAPSULE_INIT_PROJECT_TOOL = $ENV{CAPSULE_INIT_PROJECT_TOOL};

if (! length $CAPSULE_INIT_PROJECT_TOOL) {
93
    $CAPSULE_INIT_PROJECT_TOOL = `$PKG_CONFIG --variable=CAPSULE_INIT_PROJECT_TOOL libcapsule-tools`;
94
95
96
97
98
99
100
101
102
103
104
105
    chomp $CAPSULE_INIT_PROJECT_TOOL;
}

=item $CAPSULE_SYMBOLS_TOOL

The B<capsule-symbols>(1) development tool.

=cut

our $CAPSULE_SYMBOLS_TOOL = $ENV{CAPSULE_SYMBOLS_TOOL};

if (! length $CAPSULE_SYMBOLS_TOOL) {
106
    $CAPSULE_SYMBOLS_TOOL = `$PKG_CONFIG --variable=CAPSULE_SYMBOLS_TOOL libcapsule-tools`;
107
108
109
110
111
112
113
114
115
116
117
118
    chomp $CAPSULE_SYMBOLS_TOOL;
}

=item $CAPSULE_VERSION_TOOL

The B<capsule-version>(1) development tool.

=cut

our $CAPSULE_VERSION_TOOL = $ENV{CAPSULE_VERSION_TOOL};

unless (defined $CAPSULE_VERSION_TOOL) {
119
    $CAPSULE_VERSION_TOOL = `$PKG_CONFIG --variable=CAPSULE_VERSION_TOOL libcapsule-tools`;
120
121
122
    chomp $CAPSULE_VERSION_TOOL;
}

123
124
125
126
127
128
129
130
131
132
133
134
=item $NM

The B<nm>(1) symbol-name-listing utility, configured for BSD output format.

=cut

our $NM = $ENV{NM};

if (! length $NM) {
    $NM = 'nm -B';
}

Simon McVittie's avatar
Simon McVittie committed
135
136
137
138
139
140
141
142
143
=item $srcdir

An appropriate directory to find non-generated files: the top directory
of the source tree, or the root directory of this package's GLib-style
installed-tests.

=cut

# G_TEST_* convention stolen from GLib, even though we aren't using GTest
144
my (undef, $here, undef) = File::Spec->splitpath($INC{'CapsuleTest.pm'});
Simon McVittie's avatar
Simon McVittie committed
145
our $srcdir = $ENV{G_TEST_SRCDIR};
146
$srcdir = abs_path("$here/..") unless defined $srcdir;
Simon McVittie's avatar
Simon McVittie committed
147
148
149
150
151
152
153
154
155
156

=item $builddir

An appropriate directory to find non-generated files: the top directory
of the build tree, or the root directory of this package's GLib-style
installed-tests.

=cut

our $builddir = $ENV{G_TEST_BUILDDIR};
157
$builddir = abs_path("$here/..") unless defined $builddir;
Simon McVittie's avatar
Simon McVittie committed
158
159
160
161
162
163
164
165
166
167

diag "Source or installation directory: $srcdir";
diag "Build or installation directory: $builddir";

=back

=head1 EXPORTED FUNCTIONS

=over

168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
=item assert_run_verbose(I<ARGV>, ...)

Log the given command, run it, and die if it didn't return success.
I<ARGV> is an array-reference containing arguments.
Subsequent parameters are passed to C<IPC::Run::run> and can be used
to redirect output.

=cut

sub assert_run_verbose {
    my $argv = shift;
    my $debug = join(' ', @$argv);
    diag($debug);
    if (! run($argv, @_)) {
        my $explained = explain_wait_status($?);
        die "Command exited with status $? ($explained): '$debug'";
    }
}

Simon McVittie's avatar
Simon McVittie committed
187
188
189
190
191
192
193
194
195
196
197
198
199
=item diag_multiline(I<TEXT>)

Split I<TEXT> into lines and emit them as TAP diagnostics.

=cut

sub diag_multiline {
    foreach my $line (split /^/m, shift) {
        chomp $line;
        diag "    $line";
    }
}

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
=item explain_wait_status(I<CODE>)

Convert Unix-style wait status I<CODE> into something human-readable.

=cut

sub explain_wait_status {
    my $status = shift;
    my @ret;
    my $signal = $status & 127;
    my $code = ($status >> 8);

    if ($signal) {
        push @ret, "killed by signal $signal";
    }

    if ($status & 128) {
        push @ret, 'core dumped';
    }

    if ($code & 128) {
        my $maybe = $code & 127;
        unshift @ret,
            "exited with code $code (child process killed by signal $maybe?)";
    }
    elsif ($code || ! @ret) {
        unshift @ret, "exited with code $code";
    }

    return join(', ', @ret);
}

Simon McVittie's avatar
Simon McVittie committed
232
233
234
235
236
237
238
239
240
241
242
243
=item run_ok(I<ARGV>, ...)

A TAP assertion that the given command exits 0. I<ARGV> is an
array-reference containing arguments. Subsequent parameters are
passed to C<IPC::Run::run> and can be used to redirect output.

=cut

sub run_ok {
    my $argv = shift;
    my $debug = join(' ', @$argv);
    diag($debug);
244
245
246
247
248
249
250
    if (run($argv, @_)) {
        ok(1, qq{Command successful as expected: '$debug'});
    }
    else {
        my $explained = explain_wait_status($?);
        ok(0, "Command exited with status $? ($explained): '$debug'");
    }
Simon McVittie's avatar
Simon McVittie committed
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
}

=item run_verbose(I<ARGV>, ...)

Log the given command, run it, and return the same thing as
C<IPC::Run::run>. I<ARGV> is an array-reference containing arguments.
Subsequent parameters are passed to C<IPC::Run::run> and can be used
to redirect output.

=cut

sub run_verbose {
    my $argv = shift;
    my $debug = join(' ', @$argv);
    diag($debug);
    return run($argv, @_);
}

=item skip_all_unless_bwrap()

If we cannot run B<bwrap>(1), log a TAP report that all tests have been
skipped (as if via C<plan skip_all =E<gt> ...>), and exit.

=cut

sub skip_all_unless_bwrap {
    if (! run([qw(
                bwrap --ro-bind / / --unshare-ipc --unshare-net
                --unshare-pid --unshare-user --unshare-uts true
            )], '>&2')) {
        plan(skip_all => 'Cannot run bwrap');
    }
}

285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
=item skip_all_unless_nm()

If we cannot run B<nm>(1) to implement B<get_symbols_with_nm>, log a
TAP report that all tests have been skipped (as if via
C<plan skip_all =E<gt> ...>), and exit.

=cut

sub skip_all_unless_nm {
    if (! run([split(' ', $NM),
                qw(--dynamic --extern-only --defined-only
                --with-symbol-versions /bin/true)], '>/dev/null')) {
        plan(skip_all =>
            'Cannot run nm (no support for --with-symbol-versions?)');
    }
}

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
=item get_symbols_with_nm(I<LIBRARY>)

Return a list of symbols found in I<LIBRARY>, in the same format
that capsule-symbols would use.

=cut

sub get_symbols_with_nm {
    my $library = shift;
    my $output;

    run_ok([split(' ', $NM), '--dynamic', '--extern-only', '--defined-only',
            '--with-symbol-versions', $library], '>', \$output);
    my @symbols_produced;
    foreach my $line (split /\n/, $output) {
        if ($line =~ m/^[[:xdigit:]]+\s+[ABCDGIRSTW]+\s+([^@]+)(\@\@?.*)?/) {
            my $symbol = $1;
            my $version = $2;
            require CapsuleTestDpkg;
            next if CapsuleTestDpkg::symbol_is_blacklisted($symbol);
            next if "\@\@$symbol" eq $version;

            # Put them in the same format that capsule-symbols uses
            if (length $version && $version ne '@@Base') {
                push @symbols_produced, "$symbol $version";
            }
            else {
                push @symbols_produced, "$symbol ";
            }
        }
    }
    foreach my $sym (@symbols_produced) {
        diag "- $sym";
    }
    return sort @symbols_produced;
}

Simon McVittie's avatar
Simon McVittie committed
339
340
=back

341
342
343
344
=head1 ENVIRONMENT

=over

345
346
347
348
349
350
351
352
=item CAPSULE_INIT_PROJECT_TOOL

B<capsule-init-project>(1)

=item CAPSULE_SYMBOLS_TOOL

B<capsule-symbols>(1)

353
354
355
356
357
358
359
360
361
362
363
=item CAPSULE_TESTS_KEEP_TEMP

If set to a non-empty value, temporary directories created by this test
will not be cleaned up.

=cut

if (length $ENV{CAPSULE_TESTS_KEEP_TEMP}) {
    $File::Temp::KEEP_ALL = 1;
}

364
365
366
367
=item CAPSULE_VERSION_TOOL

B<capsule-version>(1)

368
369
370
371
=item NM

The B<nm>(1) symbol-name-listing utility, if not C<nm -B>.

372
373
374
375
=item PKG_CONFIG

B<pkg-config>(1)

376
377
=back

Simon McVittie's avatar
Simon McVittie committed
378
379
380
381
382
383
384
=head1 SEE ALSO

B<Test::More>(3pm), B<bwrap>(1)

=cut

1;