tests/tap/perl/Test/RRA/Automake.pm

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