tests/tap/perl/Test/RRA.pm

   1 # Helper functions for test programs written in Perl.
   2 #
   3 # This module provides a collection of helper functions used by test programs
   4 # written in Perl.  This is a general collection of functions that can be used
   5 # by both C packages with Automake and by stand-alone Perl modules.  See
   6 # Test::RRA::Automake for additional functions specifically for C Automake
   7 # distributions.
   8 #
   9 # SPDX-License-Identifier: MIT
  10
  11 package Test::RRA;
  12
  13 use 5.010;
  14 use base qw(Exporter);
  15 use strict;
  16 use warnings;
  17
  18 use Carp qw(croak);
  19 use File::Temp;
  20
  21 # Abort if Test::More was loaded before Test::RRA to be sure that we get the
  22 # benefits of the Test::More probing below.
  23 if ($INC{'Test/More.pm'}) {
  24     croak('Test::More loaded before Test::RRA');
  25 }
  26
  27 # Red Hat's base perl package doesn't include Test::More (one has to install
  28 # the perl-core package in addition).  Try to detect this and skip any Perl
  29 # tests if Test::More is not present.  This relies on Test::RRA being included
  30 # before Test::More.
  31 eval {
  32     require Test::More;
  33     Test::More->import();
  34 };
  35 if ($@) {
  36     print "1..0 # SKIP Test::More required for test\n"
  37       or croak('Cannot write to stdout');
  38     exit 0;
  39 }
  40
  41 # Declare variables that should be set in BEGIN for robustness.
  42 our (@EXPORT_OK, $VERSION);
  43
  44 # Set $VERSION and everything export-related in a BEGIN block for robustness
  45 # against circular module loading (not that we load any modules, but
  46 # consistency is good).
  47 BEGIN {
  48     @EXPORT_OK = qw(
  49         is_file_contents skip_unless_author skip_unless_automated use_prereq
  50     );
  51
  52     # This version should match the corresponding rra-c-util release, but with
  53     # two digits for the minor version, including a leading zero if necessary,
  54     # so that it will sort properly.
  55     $VERSION = '10.05';
  56 }
  57
  58 # Compare a string to the contents of a file, similar to the standard is()
  59 # function, but to show the line-based unified diff between them if they
  60 # differ.
  61 #
  62 # $got      - The output that we received
  63 # $expected - The path to the file containing the expected output
  64 # $message  - The message to use when reporting the test results
  65 #
  66 # Returns: undef
  67 #  Throws: Exception on failure to read or write files or run diff
  68 sub is_file_contents {
  69     my ($got, $expected, $message) = @_;
  70
  71     # If they're equal, this is simple.
  72     open(my $fh, '<', $expected) or BAIL_OUT("Cannot open $expected: $!\n");
  73     my $data = do { local $/ = undef; <$fh> };
  74     close($fh) or BAIL_OUT("Cannot close $expected: $!\n");
  75     if ($got eq $data) {
  76         is($got, $data, $message);
  77         return;
  78     }
  79
  80     # Otherwise, we show a diff, but only if we have IPC::System::Simple and
  81     # diff succeeds.  Otherwise, we fall back on showing the full expected and
  82     # seen output.
  83     eval {
  84         require IPC::System::Simple;
  85
  86         my $tmp = File::Temp->new();
  87         my $tmpname = $tmp->filename;
  88         print {$tmp} $got or BAIL_OUT("Cannot write to $tmpname: $!\n");
  89         my @command = ('diff', '-u', $expected, $tmpname);
  90         my $diff = IPC::System::Simple::capturex([0 .. 1], @command);
  91         diag($diff);
  92     };
  93     if ($@) {
  94         diag('Expected:');
  95         diag($expected);
  96         diag('Seen:');
  97         diag($data);
  98     }
  99
 100     # Report failure.
 101     ok(0, $message);
 102     return;
 103 }
 104
 105 # Skip this test unless author tests are requested.  Takes a short description
 106 # of what tests this script would perform, which is used in the skip message.
 107 # Calls plan skip_all, which will terminate the program.
 108 #
 109 # $description - Short description of the tests
 110 #
 111 # Returns: undef
 112 sub skip_unless_author {
 113     my ($description) = @_;
 114     if (!$ENV{AUTHOR_TESTING}) {
 115         plan(skip_all => "$description only run for author");
 116     }
 117     return;
 118 }
 119
 120 # Skip this test unless doing automated testing or release testing.  This is
 121 # used for tests that should be run by CPAN smoke testing or during releases,
 122 # but not for manual installs by end users.  Takes a short description of what
 123 # tests this script would perform, which is used in the skip message.  Calls
 124 # plan skip_all, which will terminate the program.
 125 #
 126 # $description - Short description of the tests
 127 #
 128 # Returns: undef
 129 sub skip_unless_automated {
 130     my ($description) = @_;
 131     for my $env (qw(AUTOMATED_TESTING RELEASE_TESTING AUTHOR_TESTING)) {
 132         return if $ENV{$env};
 133     }
 134     plan(skip_all => "$description normally skipped");
 135     return;
 136 }
 137
 138 # Attempt to load a module and skip the test if the module could not be
 139 # loaded.  If the module could be loaded, call its import function manually.
 140 # If the module could not be loaded, calls plan skip_all, which will terminate
 141 # the program.
 142 #
 143 # The special logic here is based on Test::More and is required to get the
 144 # imports to happen in the caller's namespace.
 145 #
 146 # $module  - Name of the module to load
 147 # @imports - Any arguments to import, possibly including a version
 148 #
 149 # Returns: undef
 150 sub use_prereq {
 151     my ($module, @imports) = @_;
 152
 153     # If the first import looks like a version, pass it as a bare string.
 154     my $version = q{};
 155     if (@imports >= 1 && $imports[0] =~ m{ \A \d+ (?: [.][\d_]+ )* \z }xms) {
 156         $version = shift(@imports);
 157     }
 158
 159     # Get caller information to put imports in the correct package.
 160     my ($package) = caller;
 161
 162     # Do the import with eval, and try to isolate it from the surrounding
 163     # context as much as possible.  Based heavily on Test::More::_eval.
 164     ## no critic (BuiltinFunctions::ProhibitStringyEval)
 165     ## no critic (ValuesAndExpressions::ProhibitImplicitNewlines)
 166     my ($result, $error, $sigdie);
 167     {
 168         local $@ = undef;
 169         local $! = undef;
 170         local $SIG{__DIE__} = undef;
 171         $result = eval qq{
 172             package $package;
 173             use $module $version \@imports;
 174             1;
 175         };
 176         $error = $@;
 177         $sigdie = $SIG{__DIE__} || undef;
 178     }
 179
 180     # If the use failed for any reason, skip the test.
 181     if (!$result || $error) {
 182         my $name = length($version) > 0 ? "$module $version" : $module;
 183         plan(skip_all => "$name required for test");
 184     }
 185
 186     # If the module set $SIG{__DIE__}, we cleared that via local.  Restore it.
 187     ## no critic (Variables::RequireLocalizedPunctuationVars)
 188     if (defined($sigdie)) {
 189         $SIG{__DIE__} = $sigdie;
 190     }
 191     return;
 192 }
 193
 194 1;
 195 __END__
 196
 197 =for stopwords
 198 Allbery Allbery's DESC bareword sublicense MERCHANTABILITY NONINFRINGEMENT
 199 rra-c-util CPAN diff
 200
 201 =head1 NAME
 202
 203 Test::RRA - Support functions for Perl tests
 204
 205 =head1 SYNOPSIS
 206
 207     use Test::RRA
 208       qw(skip_unless_author skip_unless_automated use_prereq);
 209
 210     # Skip this test unless author tests are requested.
 211     skip_unless_author('Coding style tests');
 212
 213     # Skip this test unless doing automated or release testing.
 214     skip_unless_automated('POD syntax tests');
 215
 216     # Load modules, skipping the test if they're not available.
 217     use_prereq('Perl6::Slurp', 'slurp');
 218     use_prereq('Test::Script::Run', '0.04');
 219
 220 =head1 DESCRIPTION
 221
 222 This module collects utility functions that are useful for Perl test scripts.
 223 It assumes Russ Allbery's Perl module layout and test conventions and will
 224 only be useful for other people if they use the same conventions.
 225
 226 This module B<must> be loaded before Test::More or it will abort during
 227 import.  It will skip the test (by printing a skip message to standard output
 228 and exiting with status 0, equivalent to C<plan skip_all>) during import if
 229 Test::More is not available.  This allows tests written in Perl using this
 230 module to be skipped if run on a system with Perl but not Test::More, such as
 231 Red Hat systems with the C<perl> package but not the C<perl-core> package
 232 installed.
 233
 234 =head1 FUNCTIONS
 235
 236 None of these functions are imported by default.  The ones used by a script
 237 should be explicitly imported.
 238
 239 =over 4
 240
 241 =item is_file_contents(GOT, EXPECTED, MESSAGE)
 242
 243 Check a string against the contents of a file, showing the differences if any
 244 using diff (if IPC::System::Simple and diff are available).  GOT is the output
 245 the test received.  EXPECTED is the path to a file containing the expected
 246 output (not the output itself).  MESSAGE is a message to display alongside the
 247 test results.
 248
 249 =item skip_unless_author(DESC)
 250
 251 Checks whether AUTHOR_TESTING is set in the environment and skips the whole
 252 test (by calling C<plan skip_all> from Test::More) if it is not.  DESC is a
 253 description of the tests being skipped.  A space and C<only run for author>
 254 will be appended to it and used as the skip reason.
 255
 256 =item skip_unless_automated(DESC)
 257
 258 Checks whether AUTHOR_TESTING, AUTOMATED_TESTING, or RELEASE_TESTING are set
 259 in the environment and skips the whole test (by calling C<plan skip_all> from
 260 Test::More) if they are not.  This should be used by tests that should not run
 261 during end-user installs of the module, but which should run as part of CPAN
 262 smoke testing and release testing.
 263
 264 DESC is a description of the tests being skipped.  A space and C<normally
 265 skipped> will be appended to it and used as the skip reason.
 266
 267 =item use_prereq(MODULE[, VERSION][, IMPORT ...])
 268
 269 Attempts to load MODULE with the given VERSION and import arguments.  If this
 270 fails for any reason, the test will be skipped (by calling C<plan skip_all>
 271 from Test::More) with a skip reason saying that MODULE is required for the
 272 test.
 273
 274 VERSION will be passed to C<use> as a version bareword if it looks like a
 275 version number.  The remaining IMPORT arguments will be passed as the value of
 276 an array.
 277
 278 =back
 279
 280 =head1 AUTHOR
 281
 282 Russ Allbery <eagle@eyrie.org>
 283
 284 =head1 COPYRIGHT AND LICENSE
 285
 286 Copyright 2016, 2018-2019, 2021 Russ Allbery <eagle@eyrie.org>
 287
 288 Copyright 2013-2014 The Board of Trustees of the Leland Stanford Junior
 289 University
 290
 291 Permission is hereby granted, free of charge, to any person obtaining a copy
 292 of this software and associated documentation files (the "Software"), to deal
 293 in the Software without restriction, including without limitation the rights
 294 to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 295 copies of the Software, and to permit persons to whom the Software is
 296 furnished to do so, subject to the following conditions:
 297
 298 The above copyright notice and this permission notice shall be included in all
 299 copies or substantial portions of the Software.
 300
 301 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 302 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 303 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
 304 AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 305 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
 306 OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 307 SOFTWARE.
 308
 309 =head1 SEE ALSO
 310
 311 Test::More(3), Test::RRA::Automake(3), Test::RRA::Config(3)
 312
 313 This module is maintained in the rra-c-util package.  The current version is
 314 available from L<https://www.eyrie.org/~eagle/software/rra-c-util/>.
 315
 316 The functions to control when tests are run use environment variables defined
 317 by the L<Lancaster
 318 Consensus|https://github.com/Perl-Toolchain-Gang/toolchain-site/blob/master/lancaster-consensus.md>.
 319
 320 =cut
 321
 322 # Local Variables:
 323 # copyright-at-end-flag: t
 324 # End: