From: "Daniel P. Berrange" <berrange@xxxxxxxxxx> The test case validates it recursive deletion of snapshots cleans up all children and leaves no orphans behind. --- .../domain-snapshot/100-delete-snapshot-children.t | 101 ++++++++++++++++++++ 1 files changed, 101 insertions(+), 0 deletions(-) create mode 100644 scripts/domain-snapshot/100-delete-snapshot-children.t diff --git a/scripts/domain-snapshot/100-delete-snapshot-children.t b/scripts/domain-snapshot/100-delete-snapshot-children.t new file mode 100644 index 0000000..3ebf2b9 --- /dev/null +++ b/scripts/domain-snapshot/100-delete-snapshot-children.t @@ -0,0 +1,101 @@ +# -*- perl -*- +# +# Copyright (C) 2011 Red Hat, Inc. +# +# This program is free software; You can redistribute it and/or modify +# it under the GNU General Public License as published by the Free +# Software Foundation; either version 2, or (at your option) any +# later version +# +# The file "LICENSE" distributed along with this file provides full +# details of the terms and conditions +# + +=pod + +=head1 NAME + +domain/100-delete-snapshot-children.t - recursive deletion of snapshot children + +=head1 DESCRIPTION + +The test case validates it recursive deletion of snapshots +cleans up all children and leaves no orphans behind. + +=cut + +use strict; +use warnings; + +use Test::More tests => 29; +use Test::Exception; +use Sys::Virt::TCK; +use Sys::Virt::TCK::DomainSnapshotBuilder; + +my $tck = Sys::Virt::TCK->new(); +my $conn = eval { $tck->setup(); }; +BAIL_OUT "failed to setup test harness: $@" if $@; +END { $tck->cleanup if $tck; } + +my $poolxml = $tck->generic_pool("dir")->as_xml; + +diag "Defining transient storage pool"; +my $pool; +ok_pool(sub { $pool = $conn->define_storage_pool($poolxml) }, "define transient storage pool"); +lives_ok(sub { $pool->build(0) }, "built storage pool"); +lives_ok(sub { $pool->create }, "started storage pool"); + +my $volxml = $tck->generic_volume("tck", "qcow2", 1024*1024*50)->as_xml; +my $vol; +ok_volume(sub { $vol = $pool->create_volume($volxml) }, "create qcow2 volume"); + +my $volpath = xpath($vol, "string(/volume/target/path)"); +diag "Vol path $volpath"; +my $domb = $tck->generic_domain("tck"); +$domb->{disks} = []; +my $domxml = $domb->disk(type => "file", src => $volpath, dst => "hdb", + format => {name => "qemu", type => "qcow2"})->as_xml; + +diag "Creating a new transient domain"; +my $dom; +ok_domain(sub { $dom = $conn->create_domain($domxml) }, "created transient domain object"); + + +my $ss; +for (my $i = 0 ; $i < 8 ; $i++) { + my $ssxml = Sys::Virt::TCK::DomainSnapshotBuilder->new(name => "ss$i")->as_xml; + ok_domain_snapshot(sub { $ss = $dom->create_snapshot($ssxml) }, "created domain snapshot ss$i"); +} + +lives_ok(sub { $ss = $dom->get_snapshot_by_name("ss4") }, "snapshot ss4 exists"); +lives_ok(sub { $ss->delete(Sys::Virt::DomainSnapshot::DELETE_CHILDREN) }, "deleted all snapshots from ss4 onwards"); + +for (my $i = 0 ; $i < 8 ; $i++) { + my $ss; + eval { $ss = $dom->get_snapshot_by_name("ss$i") }; + + if ($i < 4) { + ok_domain_snapshot(sub { $ss }, "snapshot ss$i still exists"); + } else { + ok(!defined $ss, "snapshot ss$i has been deleted"); + } +} + +for (my $i = 0 ; $i < 4 ; $i++) { + my $ss; + lives_ok(sub { $ss = $dom->get_snapshot_by_name("ss$i"); $ss->delete }, "deleted snapshot ss$i"); +} + + +diag "Destroying the transient domain"; +lives_ok(sub { $dom->destroy }, "destroyed domain"); + +diag "Checking that transient domain has gone away"; +ok_error(sub { $conn->get_domain_by_name("tck") }, "NO_DOMAIN error raised from missing domain", + Sys::Virt::Error::ERR_NO_DOMAIN); + +$vol->delete; +$pool->destroy; +$pool->delete; + +# end -- 1.7.6 -- libvir-list mailing list libvir-list@xxxxxxxxxx https://www.redhat.com/mailman/listinfo/libvir-list