tests/tests-lib/perl5/afstest.pm

   1 # Copyright (c) 2020 Sine Nomine Associates. All rights reserved.
   2 #
   3 # Redistribution and use in source and binary forms, with or without
   4 # modification, are permitted provided that the following conditions
   5 # are met:
   6 # 1. Redistributions of source code must retain the above copyright
   7 #    notice, this list of conditions and the following disclaimer.
   8 # 2. Redistributions in binary form must reproduce the above copyright
   9 #    notice, this list of conditions and the following disclaimer in the
  10 #    documentation and/or other materials provided with the distribution.
  11 #
  12 # THIS SOFTWARE IS PROVIDED BY THE AUTHOR `AS IS'' AND ANY EXPRESS OR
  13 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  14 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  15 # IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
  16 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  17 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  18 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  19 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  20 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  21 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  22
  23 package afstest;
  24 require Exporter;
  25 our @ISA = qw(Exporter);
  26 our @EXPORT_OK = qw(src_path obj_path);
  27
  28 sub
  29 x_path($;$)
  30 {
  31     my ($env_var, $path) = @_;
  32     my $tdir = $ENV{$env_var};
  33     if (!defined($tdir)) {
  34         # If C_TAP_SOURCE/C_TAP_BUILD isn't set, we assume we're running from
  35         # the same cwd as one of the test programs (e.g. 'tests/foo/'). So to
  36         # get to 'tests/', just go up one level.
  37         $tdir = "..";
  38     }
  39
  40     # $tdir now represents the 'tests/' dir. Go one level up to get to the
  41     # top-level dir.
  42     if (defined($path)) {
  43         return "$tdir/../$path";
  44     } else {
  45         return "$tdir/..";
  46     }
  47 }
  48
  49 sub
  50 src_path(;$)
  51 {
  52     my $path = $_[0];
  53     return x_path("C_TAP_SOURCE", $path);
  54 }
  55
  56 sub
  57 obj_path(;$)
  58 {
  59     my $path = $_[0];
  60     return x_path("C_TAP_BUILD", $path);
  61 }