aboutsummaryrefslogtreecommitdiff
path: root/nixpkgs/nixos/lib/test-driver/test-driver.pl
diff options
context:
space:
mode:
Diffstat (limited to 'nixpkgs/nixos/lib/test-driver/test-driver.pl')
-rw-r--r--nixpkgs/nixos/lib/test-driver/test-driver.pl191
1 files changed, 0 insertions, 191 deletions
diff --git a/nixpkgs/nixos/lib/test-driver/test-driver.pl b/nixpkgs/nixos/lib/test-driver/test-driver.pl
deleted file mode 100644
index a3354fb0e1e..00000000000
--- a/nixpkgs/nixos/lib/test-driver/test-driver.pl
+++ /dev/null
@@ -1,191 +0,0 @@
-#! /somewhere/perl -w
-
-use strict;
-use Machine;
-use Term::ReadLine;
-use IO::File;
-use IO::Pty;
-use Logger;
-use Cwd;
-use POSIX qw(_exit dup2);
-use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
-
-$SIG{PIPE} = 'IGNORE'; # because Unix domain sockets may die unexpectedly
-
-STDERR->autoflush(1);
-
-my $log = new Logger;
-
-
-# Start vde_switch for each network required by the test.
-my %vlans;
-foreach my $vlan (split / /, $ENV{VLANS} || "") {
- next if defined $vlans{$vlan};
- # Start vde_switch as a child process. We don't run it in daemon
- # mode because we want the child process to be cleaned up when we
- # die. Since we have to make sure that the control socket is
- # ready, we send a dummy command to vde_switch (via stdin) and
- # wait for a reply. Note that vde_switch requires stdin to be a
- # TTY, so we create one.
- $log->log("starting VDE switch for network $vlan");
- my $socket = Cwd::abs_path "./vde$vlan.ctl";
- my $pty = new IO::Pty;
- my ($stdoutR, $stdoutW); pipe $stdoutR, $stdoutW;
- my $pid = fork(); die "cannot fork" unless defined $pid;
- if ($pid == 0) {
- dup2(fileno($pty->slave), 0);
- dup2(fileno($stdoutW), 1);
- exec "vde_switch -s $socket --dirmode 0700" or _exit(1);
- }
- close $stdoutW;
- print $pty "version\n";
- readline $stdoutR or die "cannot start vde_switch";
- $ENV{"QEMU_VDE_SOCKET_$vlan"} = $socket;
- $vlans{$vlan} = $pty;
- die unless -e "$socket/ctl";
-}
-
-
-my %vms;
-my $context = "";
-
-sub createMachine {
- my ($args) = @_;
- my $vm = Machine->new({%{$args}, log => $log, redirectSerial => ($ENV{USE_SERIAL} // "0") ne "1"});
- $vms{$vm->name} = $vm;
- $context .= "my \$" . $vm->name . " = \$vms{'" . $vm->name . "'}; ";
- return $vm;
-}
-
-foreach my $vmScript (@ARGV) {
- my $vm = createMachine({startCommand => $vmScript});
-}
-
-
-sub startAll {
- $log->nest("starting all VMs", sub {
- $_->start foreach values %vms;
- });
-}
-
-
-# Wait until all VMs have terminated.
-sub joinAll {
- $log->nest("waiting for all VMs to finish", sub {
- $_->waitForShutdown foreach values %vms;
- });
-}
-
-
-# In interactive tests, this allows the non-interactive test script to
-# be executed conveniently.
-sub testScript {
- eval "$context $ENV{testScript};\n";
- warn $@ if $@;
-}
-
-
-my $nrTests = 0;
-my $nrSucceeded = 0;
-
-
-sub subtest {
- my ($name, $coderef) = @_;
- $log->nest("subtest: $name", sub {
- $nrTests++;
- eval { &$coderef };
- if ($@) {
- $log->log("error: $@", { error => 1 });
- } else {
- $nrSucceeded++;
- }
- });
-}
-
-
-sub runTests {
- if (defined $ENV{tests}) {
- $log->nest("running the VM test script", sub {
- eval "$context $ENV{tests}";
- if ($@) {
- $log->log("error: $@", { error => 1 });
- die $@;
- }
- }, { expanded => 1 });
- } else {
- my $term = Term::ReadLine->new('nixos-vm-test');
- $term->ReadHistory;
- while (defined ($_ = $term->readline("> "))) {
- eval "$context $_\n";
- warn $@ if $@;
- }
- $term->WriteHistory;
- }
-
- # Copy the kernel coverage data for each machine, if the kernel
- # has been compiled with coverage instrumentation.
- $log->nest("collecting coverage data", sub {
- foreach my $vm (values %vms) {
- my $gcovDir = "/sys/kernel/debug/gcov";
-
- next unless $vm->isUp();
-
- my ($status, $out) = $vm->execute("test -e $gcovDir");
- next if $status != 0;
-
- # Figure out where to put the *.gcda files so that the
- # report generator can find the corresponding kernel
- # sources.
- my $kernelDir = $vm->mustSucceed("echo \$(dirname \$(readlink -f /run/current-system/kernel))/.build/linux-*");
- chomp $kernelDir;
- my $coverageDir = "/tmp/xchg/coverage-data/$kernelDir";
-
- # Copy all the *.gcda files.
- $vm->execute("for d in $gcovDir/nix/store/*/.build/linux-*; do for i in \$(cd \$d && find -name '*.gcda'); do echo \$i; mkdir -p $coverageDir/\$(dirname \$i); cp -v \$d/\$i $coverageDir/\$i; done; done");
- }
- });
-
- $log->nest("syncing", sub {
- foreach my $vm (values %vms) {
- next unless $vm->isUp();
- $vm->execute("sync");
- }
- });
-
- if ($nrTests != 0) {
- $log->log("$nrSucceeded out of $nrTests tests succeeded",
- ($nrSucceeded < $nrTests ? { error => 1 } : { }));
- }
-}
-
-
-# Create an empty raw virtual disk with the given name and size (in
-# MiB).
-sub createDisk {
- my ($name, $size) = @_;
- system("qemu-img create -f raw $name ${size}M") == 0
- or die "cannot create image of size $size";
-}
-
-
-END {
- $log->nest("cleaning up", sub {
- foreach my $vm (values %vms) {
- if ($vm->{pid}) {
- $log->log("killing " . $vm->{name} . " (pid " . $vm->{pid} . ")");
- kill 9, $vm->{pid};
- }
- }
- });
- $log->close();
-}
-
-my $now1 = clock_gettime(CLOCK_MONOTONIC);
-
-runTests;
-
-my $now2 = clock_gettime(CLOCK_MONOTONIC);
-
-printf STDERR "test script finished in %.2fs\n", $now2 - $now1;
-
-exit ($nrSucceeded < $nrTests ? 1 : 0);