1# Helper functions for Perl test programs in Automake distributions.
2#
3# This module provides a collection of helper functions used by test programs
4# written in Perl and included in C source distributions that use Automake.
5# They embed knowledge of how I lay out my source trees and test suites with
6# Autoconf and Automake.  They may be usable by others, but doing so will
7# require closely following the conventions implemented by the rra-c-util
8# utility collection.
9#
10# All the functions here assume that BUILD and SOURCE are set in the
11# environment.  This is normally done via the C TAP Harness runtests wrapper.
12
13package Test::RRA::Automake;
14
15use 5.006;
16use strict;
17use warnings;
18
19# For Perl 5.006 compatibility.
20## no critic (ClassHierarchies::ProhibitExplicitISA)
21
22use Exporter;
23use File::Spec;
24use Test::More;
25use Test::RRA::Config qw($LIBRARY_PATH);
26
27# Used below for use lib calls.
28my ($PERL_BLIB_ARCH, $PERL_BLIB_LIB);
29
30# Determine the path to the build tree of any embedded Perl module package in
31# this source package.  We do this in a BEGIN block because we're going to use
32# the results in a use lib command below.
33BEGIN {
34    $PERL_BLIB_ARCH = File::Spec->catdir(qw(perl blib arch));
35    $PERL_BLIB_LIB  = File::Spec->catdir(qw(perl blib lib));
36
37    # If BUILD is set, we can come up with better values.
38    if (defined($ENV{BUILD})) {
39        my ($vol, $dirs) = File::Spec->splitpath($ENV{BUILD}, 1);
40        my @dirs = File::Spec->splitdir($dirs);
41        pop(@dirs);
42        $PERL_BLIB_ARCH = File::Spec->catdir(@dirs, qw(perl blib arch));
43        $PERL_BLIB_LIB  = File::Spec->catdir(@dirs, qw(perl blib lib));
44    }
45}
46
47# Prefer the modules built as part of our source package.  Otherwise, we may
48# not find Perl modules while testing, or find the wrong versions.
49use lib $PERL_BLIB_ARCH;
50use lib $PERL_BLIB_LIB;
51
52# Declare variables that should be set in BEGIN for robustness.
53our (@EXPORT_OK, @ISA, $VERSION);
54
55# Set $VERSION and everything export-related in a BEGIN block for robustness
56# against circular module loading (not that we load any modules, but
57# consistency is good).
58BEGIN {
59    @ISA       = qw(Exporter);
60    @EXPORT_OK = qw(automake_setup perl_dirs test_file_path test_tmpdir);
61
62    # This version should match the corresponding rra-c-util release, but with
63    # two digits for the minor version, including a leading zero if necessary,
64    # so that it will sort properly.
65    $VERSION = '5.09';
66}
67
68# Perl directories to skip globally for perl_dirs.  We ignore the perl
69# directory if it exists since, in my packages, it is treated as a Perl module
70# distribution and has its own standalone test suite.
71my @GLOBAL_SKIP = qw(.git perl);
72
73# The temporary directory created by test_tmpdir, if any.  If this is set,
74# attempt to remove the directory stored here on program exit (but ignore
75# failure to do so).
76my $TMPDIR;
77
78# Perform initial test setup for running a Perl test in an Automake package.
79# This verifies that BUILD and SOURCE are set and then changes directory to
80# the SOURCE directory by default.  Sets LD_LIBRARY_PATH if the $LIBRARY_PATH
81# configuration option is set.  Calls BAIL_OUT if BUILD or SOURCE are missing
82# or if anything else fails.
83#
84# $args_ref - Reference to a hash of arguments to configure behavior:
85#   chdir_build - If set to a true value, changes to BUILD instead of SOURCE
86#
87# Returns: undef
88sub automake_setup {
89    my ($args_ref) = @_;
90
91    # Bail if BUILD or SOURCE are not set.
92    if (!$ENV{BUILD}) {
93        BAIL_OUT('BUILD not defined (run under runtests)');
94    }
95    if (!$ENV{SOURCE}) {
96        BAIL_OUT('SOURCE not defined (run under runtests)');
97    }
98
99    # BUILD or SOURCE will be the test directory.  Change to the parent.
100    my $start = $args_ref->{chdir_build} ? $ENV{BUILD} : $ENV{SOURCE};
101    my ($vol, $dirs) = File::Spec->splitpath($start, 1);
102    my @dirs = File::Spec->splitdir($dirs);
103    pop(@dirs);
104
105    # Simplify relative paths at the end of the directory.
106    my $ups = 0;
107    my $i   = $#dirs;
108    while ($i > 2 && $dirs[$i] eq File::Spec->updir) {
109        $ups++;
110        $i--;
111    }
112    for (1 .. $ups) {
113        pop(@dirs);
114        pop(@dirs);
115    }
116    my $root = File::Spec->catpath($vol, File::Spec->catdir(@dirs), q{});
117    chdir($root) or BAIL_OUT("cannot chdir to $root: $!");
118
119    # If BUILD is a subdirectory of SOURCE, add it to the global ignore list.
120    my ($buildvol, $builddirs) = File::Spec->splitpath($ENV{BUILD}, 1);
121    my @builddirs = File::Spec->splitdir($builddirs);
122    pop(@builddirs);
123    if ($buildvol eq $vol && @builddirs == @dirs + 1) {
124        while (@dirs && $builddirs[0] eq $dirs[0]) {
125            shift(@builddirs);
126            shift(@dirs);
127        }
128        if (@builddirs == 1) {
129            push(@GLOBAL_SKIP, $builddirs[0]);
130        }
131    }
132
133    # Set LD_LIBRARY_PATH if the $LIBRARY_PATH configuration option is set.
134    ## no critic (Variables::RequireLocalizedPunctuationVars)
135    if (defined($LIBRARY_PATH)) {
136        @builddirs = File::Spec->splitdir($builddirs);
137        pop(@builddirs);
138        my $libdir = File::Spec->catdir(@builddirs, $LIBRARY_PATH);
139        my $path = File::Spec->catpath($buildvol, $libdir, q{});
140        if (-d "$path/.libs") {
141            $path .= '/.libs';
142        }
143        if ($ENV{LD_LIBRARY_PATH}) {
144            $ENV{LD_LIBRARY_PATH} .= ":$path";
145        } else {
146            $ENV{LD_LIBRARY_PATH} = $path;
147        }
148    }
149    return;
150}
151
152# Returns a list of directories that may contain Perl scripts and that should
153# be passed to Perl test infrastructure that expects a list of directories to
154# recursively check.  The list will be all eligible top-level directories in
155# the package except for the tests directory, which is broken out to one
156# additional level.  Calls BAIL_OUT on any problems
157#
158# $args_ref - Reference to a hash of arguments to configure behavior:
159#   skip - A reference to an array of directories to skip
160#
161# Returns: List of directories possibly containing Perl scripts to test
162sub perl_dirs {
163    my ($args_ref) = @_;
164
165    # Add the global skip list.
166    my @skip = $args_ref->{skip} ? @{ $args_ref->{skip} } : ();
167    push(@skip, @GLOBAL_SKIP);
168
169    # Separate directories to skip under tests from top-level directories.
170    my @skip_tests = grep { m{ \A tests/ }xms } @skip;
171    @skip = grep { !m{ \A tests }xms } @skip;
172    for my $skip_dir (@skip_tests) {
173        $skip_dir =~ s{ \A tests/ }{}xms;
174    }
175
176    # Convert the skip lists into hashes for convenience.
177    my %skip = map { $_ => 1 } @skip, 'tests';
178    my %skip_tests = map { $_ => 1 } @skip_tests;
179
180    # Build the list of top-level directories to test.
181    opendir(my $rootdir, q{.}) or BAIL_OUT("cannot open .: $!");
182    my @dirs = grep { -d && !$skip{$_} } readdir($rootdir);
183    closedir($rootdir);
184    @dirs = File::Spec->no_upwards(@dirs);
185
186    # Add the list of subdirectories of the tests directory.
187    if (-d 'tests') {
188        opendir(my $testsdir, q{tests}) or BAIL_OUT("cannot open tests: $!");
189
190        # Skip if found in %skip_tests or if not a directory.
191        my $is_skipped = sub {
192            my ($dir) = @_;
193            return 1 if $skip_tests{$dir};
194            $dir = File::Spec->catdir('tests', $dir);
195            return -d $dir ? 0 : 1;
196        };
197
198        # Build the filtered list of subdirectories of tests.
199        my @test_dirs = grep { !$is_skipped->($_) } readdir($testsdir);
200        closedir($testsdir);
201        @test_dirs = File::Spec->no_upwards(@test_dirs);
202
203        # Add the tests directory to the start of the directory name.
204        push(@dirs, map { File::Spec->catdir('tests', $_) } @test_dirs);
205    }
206    return @dirs;
207}
208
209# Find a configuration file for the test suite.  Searches relative to BUILD
210# first and then SOURCE and returns whichever is found first.  Calls BAIL_OUT
211# if the file could not be found.
212#
213# $file - Partial path to the file
214#
215# Returns: Full path to the file
216sub test_file_path {
217    my ($file) = @_;
218  BASE:
219    for my $base ($ENV{BUILD}, $ENV{SOURCE}) {
220        next if !defined($base);
221        if (-f "$base/$file") {
222            return "$base/$file";
223        }
224    }
225    BAIL_OUT("cannot find $file");
226    return;
227}
228
229# Create a temporary directory for tests to use for transient files and return
230# the path to that directory.  The directory is automatically removed on
231# program exit.  The directory permissions use the current umask.  Calls
232# BAIL_OUT if the directory could not be created.
233#
234# Returns: Path to a writable temporary directory
235sub test_tmpdir {
236    my $path;
237
238    # If we already figured out what directory to use, reuse the same path.
239    # Otherwise, create a directory relative to BUILD if set.
240    if (defined($TMPDIR)) {
241        $path = $TMPDIR;
242    } else {
243        my $base = defined($ENV{BUILD}) ? $ENV{BUILD} : File::Spec->curdir;
244        $path = File::Spec->catdir($base, 'tmp');
245    }
246
247    # Create the directory if it doesn't exist.
248    if (!-d $path) {
249        if (!mkdir($path, 0777)) {
250            BAIL_OUT("cannot create directory $path: $!");
251        }
252    }
253
254    # Store the directory name for cleanup and return it.
255    $TMPDIR = $path;
256    return $path;
257}
258
259# On program exit, remove $TMPDIR if set and if possible.  Report errors with
260# diag but otherwise ignore them.
261END {
262    if (defined($TMPDIR) && -d $TMPDIR) {
263        local $! = undef;
264        if (!rmdir($TMPDIR)) {
265            diag("cannot remove temporary directory $TMPDIR: $!");
266        }
267    }
268}
269
2701;
271__END__
272
273=for stopwords
274Allbery Automake Automake-aware Automake-based rra-c-util ARGS
275subdirectories sublicense MERCHANTABILITY NONINFRINGEMENT umask
276
277=head1 NAME
278
279Test::RRA::Automake - Automake-aware support functions for Perl tests
280
281=head1 SYNOPSIS
282
283    use Test::RRA::Automake qw(automake_setup perl_dirs test_file_path);
284    automake_setup({ chdir_build => 1 });
285
286    # Paths to directories that may contain Perl scripts.
287    my @dirs = perl_dirs({ skip => [qw(lib)] });
288
289    # Configuration for Kerberos tests.
290    my $keytab = test_file_path('config/keytab');
291
292=head1 DESCRIPTION
293
294This module collects utility functions that are useful for test scripts
295written in Perl and included in a C Automake-based package.  They assume
296the layout of a package that uses rra-c-util and C TAP Harness for the
297test structure.
298
299Loading this module will also add the directories C<perl/blib/arch> and
300C<perl/blib/lib> to the Perl library search path, relative to BUILD if
301that environment variable is set.  This is harmless for C Automake
302projects that don't contain an embedded Perl module, and for those
303projects that do, this will allow subsequent C<use> calls to find modules
304that are built as part of the package build process.
305
306The automake_setup() function should be called before calling any other
307functions provided by this module.
308
309=head1 FUNCTIONS
310
311None of these functions are imported by default.  The ones used by a
312script should be explicitly imported.  On failure, all of these functions
313call BAIL_OUT (from Test::More).
314
315=over 4
316
317=item automake_setup([ARGS])
318
319Verifies that the BUILD and SOURCE environment variables are set and
320then changes directory to the top of the source tree (which is one
321directory up from the SOURCE path, since SOURCE points to the top of
322the tests directory).
323
324If ARGS is given, it should be a reference to a hash of configuration
325options.  Only one option is supported: C<chdir_build>.  If it is set
326to a true value, automake_setup() changes directories to the top of
327the build tree instead.
328
329=item perl_dirs([ARGS])
330
331Returns a list of directories that may contain Perl scripts that should be
332tested by test scripts that test all Perl in the source tree (such as
333syntax or coding style checks).  The paths will be simple directory names
334relative to the current directory or two-part directory names under the
335F<tests> directory.  (Directories under F<tests> are broken out separately
336since it's common to want to apply different policies to different
337subdirectories of F<tests>.)
338
339If ARGS is given, it should be a reference to a hash of configuration
340options.  Only one option is supported: C<skip>, whose value should be a
341reference to an array of additional top-level directories or directories
342starting with C<tests/> that should be skipped.
343
344=item test_file_path(FILE)
345
346Given FILE, which should be a relative path, locates that file relative to
347the test directory in either the source or build tree.  FILE will be
348checked for relative to the environment variable BUILD first, and then
349relative to SOURCE.  test_file_path() returns the full path to FILE or
350calls BAIL_OUT if FILE could not be found.
351
352=item test_tmpdir()
353
354Create a temporary directory for tests to use for transient files and
355return the path to that directory.  The directory is created relative to
356the BUILD environment variable, which must be set.  Permissions on the
357directory are set using the current umask.  test_tmpdir() returns the full
358path to the temporary directory or calls BAIL_OUT if it could not be
359created.
360
361The directory is automatically removed if possible on program exit.
362Failure to remove the directory on exit is reported with diag() and
363otherwise ignored.
364
365=back
366
367=head1 AUTHOR
368
369Russ Allbery <eagle@eyrie.org>
370
371=head1 COPYRIGHT AND LICENSE
372
373Copyright 2014 Russ Allbery <eagle@eyrie.org>
374
375Copyright 2013 The Board of Trustees of the Leland Stanford Junior
376University
377
378Permission is hereby granted, free of charge, to any person obtaining a
379copy of this software and associated documentation files (the "Software"),
380to deal in the Software without restriction, including without limitation
381the rights to use, copy, modify, merge, publish, distribute, sublicense,
382and/or sell copies of the Software, and to permit persons to whom the
383Software is furnished to do so, subject to the following conditions:
384
385The above copyright notice and this permission notice shall be included in
386all copies or substantial portions of the Software.
387
388THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
389IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
390FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
391THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
392LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
393FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
394DEALINGS IN THE SOFTWARE.
395
396=head1 SEE ALSO
397
398Test::More(3), Test::RRA(3), Test::RRA::Config(3)
399
400The C TAP Harness test driver and libraries for TAP-based C testing are
401available from L<http://www.eyrie.org/~eagle/software/c-tap-harness/>.
402
403This module is maintained in the rra-c-util package.  The current version
404is available from L<http://www.eyrie.org/~eagle/software/rra-c-util/>.
405
406=cut
407