diff options
Diffstat (limited to '')
| -rw-r--r-- | t/Test/DH.pm | 205 |
1 files changed, 205 insertions, 0 deletions
diff --git a/t/Test/DH.pm b/t/Test/DH.pm new file mode 100644 index 0000000..7fa30bf --- /dev/null +++ b/t/Test/DH.pm @@ -0,0 +1,205 @@ +package Test::DH; + +use strict; +use warnings; + +use Test::More; + +use Cwd qw(getcwd realpath); +use Errno qw(EEXIST); +use Exporter qw(import); + +use File::Temp qw(tempdir); +use File::Path qw(remove_tree make_path); +use File::Basename qw(dirname); + +our $ROOT_DIR; + +BEGIN { + my $res = realpath(__FILE__) or die('Cannot resolve ' . __FILE__ . ": $!"); + $ROOT_DIR = dirname(dirname(dirname($res))); +}; + +use lib "$ROOT_DIR/lib"; + +# These should be done before Dh_lib is loaded. +BEGIN { + $ENV{PATH} = "$ROOT_DIR:$ENV{PATH}" if $ENV{PATH} !~ m{\Q$ROOT_DIR\E/?:}; + $ENV{PERL5LIB} = join(':', "${ROOT_DIR}/lib", (grep {defined} $ENV{PERL5LIB})) + if not $ENV{PERL5LIB} or $ENV{PERL5LIB} !~ m{\Q$ROOT_DIR\E(?:/lib)?/?:}; + $ENV{DH_DATAFILES} = "${ROOT_DIR}/t/fixtures:${ROOT_DIR}"; + # Nothing in the tests requires root. + $ENV{DEB_RULES_REQUIRES_ROOT} = 'no'; + # Disable colors for good measure + $ENV{DH_COLORS} = 'never'; + $ENV{DPKG_COLORS} = 'never'; + + # Drop DEB_BUILD_PROFILES and DEB_BUILD_OPTIONS so they don't interfere + delete($ENV{DEB_BUILD_PROFILES}); + delete($ENV{DEB_BUILD_OPTIONS}); +}; + +use Debian::Debhelper::Dh_Lib qw(!dirname); + +our @EXPORT = qw( + each_compat_up_to_and_incl_subtest each_compat_subtest + each_compat_from_and_above_subtest run_dh_tool + create_empty_file readlines + error find_script non_deprecated_compat_levels + each_compat_from_x_to_and_incl_y_subtest +); + +our ($TEST_DH_COMPAT); + +my $START_DIR = getcwd(); +my $TEST_DIR; + +sub run_dh_tool { + my (@cmd) = @_; + my $compat = $TEST_DH_COMPAT; + my $options = ref($cmd[0]) ? shift(@cmd) : {}; + my $pid; + + $pid = fork() // BAIL_OUT("fork failed: $!"); + if (not $pid) { + $ENV{DH_COMPAT} = $compat; + $ENV{DH_INTERNAL_TESTSUITE_SILENT_WARNINGS} = 1; + if (defined(my $env = $options->{env})) { + for my $k (sort(keys(%{$env}))) { + if (defined($env->{$k})) { + $ENV{$k} = $env->{$k}; + } else { + delete($ENV{$k}); + } + } + } + if ($options->{quiet}) { + open(STDOUT, '>', '/dev/null') or error("Reopen stdout: $!"); + open(STDERR, '>', '/dev/null') or error("Reopen stderr: $!"); + } else { + # If run under prove/TAP, we don't want to confuse the test runner. + open(STDOUT, '>&', *STDERR) or error("Redirect stdout to stderr: $!"); + } + exec(@cmd); + } + waitpid($pid, 0) == $pid or BAIL_OUT("waitpid($pid) failed: $!"); + return 1 if not $?; + return 0; +} + +sub _prepare_test_root { + my $dir = tempdir(CLEANUP => 1); + if (not mkdir("$dir/debian", 0777)) { + error("mkdir $dir/debian failed: $!") + if $! != EEXIST; + } else { + # auto seed it + my @files = qw( + debian/control + debian/compat + debian/changelog + ); + for my $file (@files) { + install_file($file, "${dir}/${file}"); + } + if (@::TEST_DH_EXTRA_TEMPLATE_FILES) { + my $test_dir = ($TEST_DIR //= dirname($0)); + my $fixture_dir = $::TEST_DH_FIXTURE_DIR // '.'; + my $actual_dir = "$test_dir/$fixture_dir"; + for my $file (@::TEST_DH_EXTRA_TEMPLATE_FILES) { + if (index($file, '/') > -1) { + my $install_dir = dirname($file); + install_dir($install_dir); + } + install_file("${actual_dir}/${file}", "${dir}/${file}"); + } + } + } + return $dir; +} + +sub each_compat_from_x_to_and_incl_y_subtest($$&) { + my ($compat, $high_compat, $code) = @_; + my $lowest = Debian::Debhelper::Dh_Lib::MIN_COMPAT_LEVEL; + my $highest = Debian::Debhelper::Dh_Lib::MAX_COMPAT_LEVEL; + error("compat $compat is no longer support! Min compat $lowest") + if $compat < $lowest; + error("$high_compat is from the future! Max known is $highest") + if $high_compat > $highest; + subtest '' => sub { + # Keep $dir alive until the test is over + my $dir = _prepare_test_root; + chdir($dir) or error("chdir($dir): $!"); + while ($compat <= $high_compat) { + local $TEST_DH_COMPAT = $compat; + $code->($compat); + ++$compat; + } + chdir($START_DIR) or error("chdir($START_DIR): $!"); + }; + return; +} + +sub each_compat_up_to_and_incl_subtest($&) { + unshift(@_, Debian::Debhelper::Dh_Lib::MIN_COMPAT_LEVEL); + goto \&each_compat_from_x_to_and_incl_y_subtest; +} + +sub each_compat_from_and_above_subtest($&) { + splice(@_, 1, 0, Debian::Debhelper::Dh_Lib::MAX_COMPAT_LEVEL); + goto \&each_compat_from_x_to_and_incl_y_subtest; +} + +sub each_compat_subtest(&) { + unshift(@_, + Debian::Debhelper::Dh_Lib::MIN_COMPAT_LEVEL, + Debian::Debhelper::Dh_Lib::MAX_COMPAT_LEVEL); + goto \&each_compat_from_x_to_and_incl_y_subtest; +} + +sub create_empty_file { + my ($file, $chmod) = @_; + open(my $fd, '>', $file) or die("open($file): $!\n"); + close($fd) or die("close($file): $!\n"); + if (defined($chmod)) { + chmod($chmod, $file) + or die(sprintf('chmod(%04o, %s): %s', $chmod, $file, $!)); + } + return 1; +} + +sub readlines { + my ($h) = @_; + my @lines = <$h>; + close $h; + chop @lines; + return \@lines; +} + +# In *inst order (find_script will shuffle them around for *rm order) +my @SNIPPET_FILE_TEMPLATES = ( + 'debian/#PACKAGE#.#SCRIPT#.debhelper', + 'debian/.debhelper/generated/#PACKAGE#/#SCRIPT#.service', +); + +sub find_script { + my ($package, $script) = @_; + my @files; + for my $template (@SNIPPET_FILE_TEMPLATES) { + my $file = ($template =~ s/#PACKAGE#/$package/r); + $file =~ s/#SCRIPT#/$script/; + push(@files, $file) if -f $file; + } + if ($script eq 'postrm' or $script eq 'prerm') { + @files = reverse(@files); + } + return @files; +} + +sub non_deprecated_compat_levels() { + my $start = Debian::Debhelper::Dh_Lib::LOWEST_NON_DEPRECATED_COMPAT_LEVEL; + my $end = Debian::Debhelper::Dh_Lib::MAX_COMPAT_LEVEL; + return ($start..$end); +} + +1; |