diff --git a/bin/libvirt-tck b/bin/libvirt-tck index 352f6d4f36a92e3babd66cd60044fd8652fc08ff..cfff75bfe3988500bb796117e62d3071d5469e51 100644 --- a/bin/libvirt-tck +++ b/bin/libvirt-tck @@ -78,13 +78,23 @@ the name of each test case Specify the name of the configuration file to use, rather than the default C -=item -f, --format text|html|xml +=item --format text|html|xml Choose the output format for the test results. The default format is C, producing human readable results on the console. The C option dumps an HTML file of results to STDOUT, while the C option generates a formal XML document of results. +=item --force + +Forcably remove all running guest domains and all persistent guest +domain configuration files before running any tests. The test suite +requires a pristine install, so all existing managed objects must +be removed before running. This switch will instruct libvirt-tck +to automatically remove all guest domains. YOU WILL NOT GET YOUR +EXISTING GUEST DOMAINS BACK IF THIS HAPPENS. THEY WILL BE GONE +FOREVER. USE AT YOUR OWN RISK. + =item -t, --testdir PATH Specify an alternate directory path in which to find the test @@ -120,6 +130,7 @@ my $confdir = catdir(rootdir(), qw(etc libvirt-tck)); my $verbose = 0; my $quiet = 0; my $help = 0; +my $force = 0; my $archive; my $config = catfile($confdir, "default.cfg"); my $format = "text"; @@ -130,6 +141,7 @@ GetOptions("verbose" => \$verbose, "help" => \$help, "archive=s" => \$archive, "config=s" => \$config, + "force" => \$force, "format=s" => \$format, "testdir=s" => \$testdir); @@ -178,6 +190,7 @@ if ($format eq "xml") { # This env variable is the only way to pass config into # the Sys::Virt::TCK module from here $ENV{LIBVIRT_TCK_CONFIG} = $config; +$ENV{LIBVIRT_TCK_AUTOCLEAN} = $force; my $app = App::Prove->new; $app->process_args(@newargv); diff --git a/lib/Sys/Virt/TCK.pm b/lib/Sys/Virt/TCK.pm index fd5057846ced78c98e8678747b89bc1e737a6721..5aaae5cd074e359b13727a04e254c358d55dd3f8 100644 --- a/lib/Sys/Virt/TCK.pm +++ b/lib/Sys/Virt/TCK.pm @@ -25,6 +25,9 @@ sub new { $self->{config} = $params{config} ? $params{config} : Config::Record->new(file => ($ENV{LIBVIRT_TCK_CONFIG} || "/etc/tck.conf")); + $self->{autoclean} = $params{autoclean} ? $params{autoclean} : + ($ENV{LIBVIRT_TCK_AUTOCLEAN} || 0); + bless $self, $class; return $self; @@ -39,11 +42,28 @@ sub setup { my $type = $self->{conn}->get_type(); $self->{type} = lc $type; - $self->reset; + $self->reset if $self->{autoclean}; + + $self->sanity_check; return $self->{conn}; } + +sub sanity_check { + my $self = shift; + + my @doms = $self->{conn}->list_domains; + if (@doms) { + die "there is/are " . int(@doms) . " pre-existing active domain(s) in this driver"; + } + + @doms = $self->{conn}->list_defined_domains; + if (@doms) { + die "there is/are " . int(@doms) . " pre-existing inactive domain(s) in this driver"; + } +} + sub reset { my $self = shift;