summary refs log tree commit diff
path: root/nixos/lib/test-driver/test-driver.pl
diff options
context:
space:
mode:
Diffstat (limited to 'nixos/lib/test-driver/test-driver.pl')
-rw-r--r--nixos/lib/test-driver/test-driver.pl191
1 files changed, 0 insertions, 191 deletions
diff --git a/nixos/lib/test-driver/test-driver.pl b/nixos/lib/test-driver/test-driver.pl
deleted file mode 100644
index a3354fb0e1e..00000000000
--- a/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);