[libvirt] [libvirt-tck PATCH v2 1/3] add three APIs testing for block

new script for block APIs dom->block_resize dom->get_block_info dom->block_peek --- scripts/domain/121-block-info.t | 137 +++++++++++++++++++++++++++++++++++++++ 1 files changed, 137 insertions(+), 0 deletions(-) create mode 100644 scripts/domain/121-block-info.t diff --git a/scripts/domain/121-block-info.t b/scripts/domain/121-block-info.t new file mode 100644 index 0000000..17ebb2e --- /dev/null +++ b/scripts/domain/121-block-info.t @@ -0,0 +1,137 @@ +# -*- perl -*- +# +# Copyright (C) 2013 Red Hat, Inc. +# Copyright (C) 2013 Zhe Peng <zpeng@redhat.com> +# +# 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/121-block-info.t + +=head1 DESCRIPTION + +The test case validates that all following APIs work well include +dom->block_resize +dom->get_block_info +dom->block_peek + +=cut + +use strict; +use warnings; + +use Test::More tests => 29; + +use Sys::Virt::TCK; +use Test::Exception; +use File::stat; + +my $tck = Sys::Virt::TCK->new(); +my $conn = eval { $tck->setup(); }; +BAIL_OUT "failed to setup test harness: $@" if $@; +END { + $tck->cleanup if $tck; +} + +# test is_alive +my $live = $conn->is_alive(); +ok($live > 0, "Connection is alive"); + +my $xml = $tck->generic_pool("dir")->as_xml; + +diag "Defining transient storage pool"; +my $pool; +ok_pool(sub { $pool = $conn->define_storage_pool($xml) }, "define transient storage pool"); +lives_ok(sub { $pool->build(0) }, "built storage pool"); +lives_ok(sub { $pool->create }, "started storage pool"); + +my $volallocxml = $tck->generic_volume("tck", "raw", 1024*1024*50)->allocation(1024*1024*50)->as_xml; +my ($vol, $path, $st); +ok_volume { $vol = $pool->create_volume($volallocxml) } "create fully allocated raw volume"; + +my $volallocxml2 = $tck->generic_volume("tck2", "raw", 1024*1024*50)->allocation(1024*1024)->as_xml; +my ($vol2, $path2, $st2); +ok_volume { $vol2 = $pool->create_volume($volallocxml2) } "create not fully allocated raw volume"; + +my $volallocxml3 = $tck->generic_volume("tck3", "qcow2", 1024*1024*50)->allocation(1024*1024)->as_xml; +my ($vol3, $path3, $st3); +ok_volume { $vol3 = $pool->create_volume($volallocxml3) } "create qcow2 volume"; + +$path = xpath($vol, "string(/volume/target/path)"); +$st = stat($path); +ok($st, "path $path exists"); +is($st->size, 1024*1024*50, "size is 50M"); + +$path2 = xpath($vol2, "string(/volume/target/path)"); +$st2 = stat($path2); +ok($st2, "path $path2 exists"); + +$path3 = xpath($vol3, "string(/volume/target/path)"); +$st3 = stat($path3); +ok($st3, "path $path3 exists"); + +diag "Generic guest with pervious created vol"; +my $disktype = "raw"; +my $dst = "vda"; +my $dst2 = "vdb"; +my $dst3 = "vdc"; +my $guest = $tck->generic_domain("tck"); +$guest->rmdisk(); + +$guest->disk(format => { name => "qemu", type => $disktype }, type => "file", src => $path, dst => $dst); +$guest->disk(format => { name => "qemu", type => $disktype }, type => "file", src=> $path2, dst => $dst2); +$guest->disk(format => { name => "qemu", type => "qcow2" }, type => "file", src=> $path3, dst => $dst3); +$guest->interface(type => "network", source => "default", model => "virtio", mac => "52:54:00:22:22:22"); + +$xml = $guest->as_xml; +my $dom; +ok_domain(sub { $dom = $conn->create_domain($xml) }, "Create domain"); +$xml = $dom->get_xml_description(); + +is($dom->get_block_info($dst2,0)->{capacity}, 1024*1024*50, "Get disk capacity info"); +is($dom->get_block_info($dst2,0)->{allocation}, 1024*1024, "Get disk allocation info"); +is($dom->get_block_info($dst2,0)->{physical}, 1024*1024, "Get disk physical info"); + + +is($dom->get_block_info($dst,0)->{capacity}, 1024*1024*50, "Get disk capacity info"); +is($dom->get_block_info($dst,0)->{allocation}, 1024*1024*50, "Get disk allocation info"); +is($dom->get_block_info($dst,0)->{physical}, 1024*1024*50, "Get disk physical info"); + +diag "Test block_resize"; +lives_ok(sub {$dom->block_resize($dst, 512*50)}, "resize to 512*50 KB"); +$st = stat($path); +is($st->size, 512*1024*50, "size is 25M"); + +is($dom->get_block_info($dst,0)->{capacity}, 1024*512*50, "Get disk capacity info"); +is($dom->get_block_info($dst,0)->{allocation}, 1024*512*50, "Get disk allocation info"); +is($dom->get_block_info($dst,0)->{physical}, 1024*512*50, "Get disk physical info"); + +lives_ok(sub {$dom->block_resize($dst, 1024*50)}, "resize to 1024*50 KB"); +$st = stat($path); +is($st->size, 1024*1024*50, "size is 50M"); + +diag "Test block_peek"; +my $date = "test"; +system("echo $date > $path"); +is($dom->block_peek($path,0,4,0), $date, "Get date from raw image"); + +#qcow2 file start with hexadecimal:0x51 0x46 0x49 (ASCII: "QFI") +is($dom->block_peek($path3,0,3,0), "QFI", "Get date from qcow2 image"); + +lives_ok(sub { $vol->delete(0) }, "deleted volume"); + +diag "Destroy domain"; +$dom->destroy; + +ok_error(sub { $conn->get_domain_by_name("tck") }, "NO_DOMAIN error raised from missing domain", 42); + -- 1.7.7.6

new script for interface parameters APIs dom->get_interface_parameters dom->set_interface_parameters con->is_alive --- scripts/domain/180-interface-parameters.t | 84 +++++++++++++++++++++++++++++ 1 files changed, 84 insertions(+), 0 deletions(-) create mode 100644 scripts/domain/180-interface-parameters.t diff --git a/scripts/domain/180-interface-parameters.t b/scripts/domain/180-interface-parameters.t new file mode 100644 index 0000000..8b4cb0d --- /dev/null +++ b/scripts/domain/180-interface-parameters.t @@ -0,0 +1,84 @@ +# -*- perl -*- +# +# Copyright (C) 2012 Red Hat, Inc. +# Copyright (C) 2012 Kyla Zhang <weizhan@redhat.com> +# +# 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/180-interface-parameters.t - test interface set/get + +=head1 DESCRIPTION + +The test case validates that all following APIs work well include +dom->get_interface_parameters +dom->set_interface_parameters +con->is_alive + +=cut + +use strict; +use warnings; + +use Test::More tests => 10; + +use Sys::Virt::TCK; +use Test::Exception; +use File::stat; + +my $tck = Sys::Virt::TCK->new(); +my $conn = eval { $tck->setup(); }; +BAIL_OUT "failed to setup test harness: $@" if $@; +END { + $tck->cleanup if $tck; +} + +# test is_alive +my $live = $conn->is_alive(); +ok($live > 0, "Connection is alive"); + +my $xml = $tck->generic_domain("tck") + ->interface(type => "network", source => "default", model => "virtio", mac => "52:54:00:22:22:22") + ->as_xml; + +my $dom; +ok_domain(sub { $dom = $conn->create_domain($xml) }, "Create domain"); +$xml = $dom->get_xml_description(); + +diag "Set/Get interface parameters"; +my %params = (Sys::Virt::Domain::BANDWIDTH_IN_AVERAGE=>1000, Sys::Virt::Domain::BANDWIDTH_IN_PEAK=>1001, + Sys::Virt::Domain::BANDWIDTH_IN_BURST=>1002, Sys::Virt::Domain::BANDWIDTH_OUT_AVERAGE=>1003, + Sys::Virt::Domain::BANDWIDTH_OUT_PEAK=>1004, Sys::Virt::Domain::BANDWIDTH_OUT_BURST=>1005); +lives_ok(sub {$dom->set_interface_parameters("vnet0", \%params)}, "Set vnet0 parameters"); +for my $key (sort keys %params) { + diag "Set $key => $params{$key} "; +} + +my $param = $dom->get_interface_parameters("vnet0", 0); +my $in_average = $param->{Sys::Virt::Domain::BANDWIDTH_IN_AVERAGE}; +my $in_burst = $param->{Sys::Virt::Domain::BANDWIDTH_IN_BURST}; +my $in_peak = $param->{Sys::Virt::Domain::BANDWIDTH_IN_PEAK}; +my $out_average = $param->{Sys::Virt::Domain::BANDWIDTH_OUT_AVERAGE}; +my $out_burst = $param->{Sys::Virt::Domain::BANDWIDTH_OUT_BURST}; +my $out_peak = $param->{Sys::Virt::Domain::BANDWIDTH_OUT_PEAK}; +is($in_average, 1000, "Get inbound average 1000"); +is($in_burst, 1002, "Get inbound burst 1002"); +is($in_peak, 1001, "Get inbound peak 1001"); +is($out_average, 1003, "Get outbound average 1003"); +is($out_burst, 1005, "Get outbound burst 1005"); +is($out_peak, 1004, "Get outbound peak 1004"); + +diag "Destroy domain"; +$dom->destroy; + +ok_error(sub { $conn->get_domain_by_name("tck") }, "NO_DOMAIN error raised from missing domain", 42); -- 1.7.7.6

On Fri, May 10, 2013 at 03:17:53PM +0800, Zhe Peng wrote:
new script for interface parameters APIs dom->get_interface_parameters dom->set_interface_parameters con->is_alive --- scripts/domain/180-interface-parameters.t | 84 +++++++++++++++++++++++++++++ 1 files changed, 84 insertions(+), 0 deletions(-) create mode 100644 scripts/domain/180-interface-parameters.t
ACK Daniel -- |: http://berrange.com -o- http://www.flickr.com/photos/dberrange/ :| |: http://libvirt.org -o- http://virt-manager.org :| |: http://autobuild.org -o- http://search.cpan.org/~danberr/ :| |: http://entangle-photo.org -o- http://live.gnome.org/gtk-vnc :|

new script for migrate max speed APIs dom->migrate_get_max_speed dom->migrate_set_max_speed --- scripts/domain/301-migration-max-speed.t | 64 ++++++++++++++++++++++++++++ 1 files changed, 64 insertions(+), 0 deletions(-) create mode 100644 scripts/domain/301-migration-max-speed.t diff --git a/scripts/domain/301-migration-max-speed.t b/scripts/domain/301-migration-max-speed.t new file mode 100644 index 0000000..a07d244 --- /dev/null +++ b/scripts/domain/301-migration-max-speed.t @@ -0,0 +1,64 @@ +# -*- perl -*- +# +# Copyright (C) 2013 Red Hat, Inc. +# Copyright (C) 2013 Zhe Peng <zpeng@redhat.com> +# +# 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/301-migrate-max-speed.t - test migrate max speed set/get + +=head1 DESCRIPTION + +The test case validates that all following APIs work well include +dom->migrate_get_max_speed +dom->migrate_set_max_speed + +=cut + +use strict; +use warnings; + +use Test::More tests => 5; + +use Sys::Virt::TCK; +use Test::Exception; +use File::stat; + +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 $xml = $tck->generic_domain("tck")->as_xml; + +my $dom; +ok_domain(sub { $dom = $conn->create_domain($xml) }, "Create domain"); + +diag "Get migrate max speed"; +my $speed = $dom->migrate_get_max_speed(); +ok($speed, "Get migrate max speed $speed"); + +diag "Set migrate max speed"; +$speed = 10000; +lives_ok(sub {$dom->migrate_set_max_speed($speed)}, "Set max speed to $speed"); +my $get_speed = $dom->migrate_get_max_speed(); +is ($speed, $get_speed, "Get speed same as set"); + +diag "Destroy domain"; +$dom->destroy; + +ok_error(sub { $conn->get_domain_by_name("tck") }, "NO_DOMAIN error raised from missing domain", 42); + -- 1.7.7.6

On Fri, May 10, 2013 at 03:17:54PM +0800, Zhe Peng wrote:
new script for migrate max speed APIs dom->migrate_get_max_speed dom->migrate_set_max_speed --- scripts/domain/301-migration-max-speed.t | 64 ++++++++++++++++++++++++++++ 1 files changed, 64 insertions(+), 0 deletions(-) create mode 100644 scripts/domain/301-migration-max-speed.t
ACK Daniel -- |: http://berrange.com -o- http://www.flickr.com/photos/dberrange/ :| |: http://libvirt.org -o- http://virt-manager.org :| |: http://autobuild.org -o- http://search.cpan.org/~danberr/ :| |: http://entangle-photo.org -o- http://live.gnome.org/gtk-vnc :|

On 05/14/2013 08:50 AM, Daniel P. Berrange wrote:
On Fri, May 10, 2013 at 03:17:54PM +0800, Zhe Peng wrote:
new script for migrate max speed APIs dom->migrate_get_max_speed dom->migrate_set_max_speed --- scripts/domain/301-migration-max-speed.t | 64 ++++++++++++++++++++++++++++ 1 files changed, 64 insertions(+), 0 deletions(-) create mode 100644 scripts/domain/301-migration-max-speed.t
ACK
All three patches pushed now. -- Eric Blake eblake redhat com +1-919-301-3266 Libvirt virtualization library http://libvirt.org

On 05/14/2013 10:58 AM, Eric Blake wrote:
On 05/14/2013 08:50 AM, Daniel P. Berrange wrote:
On Fri, May 10, 2013 at 03:17:54PM +0800, Zhe Peng wrote:
new script for migrate max speed APIs dom->migrate_get_max_speed dom->migrate_set_max_speed --- scripts/domain/301-migration-max-speed.t | 64 ++++++++++++++++++++++++++++ 1 files changed, 64 insertions(+), 0 deletions(-) create mode 100644 scripts/domain/301-migration-max-speed.t
ACK
All three patches pushed now.
Minor correction - my attempt to push was rejected until I touched up your patch to fix these whitespace problems: Compressing objects: 100% (15/15), done. Writing objects: 100% (15/15), 4.29 KiB, done. Total 15 (delta 10), reused 0 (delta 0) remote: scripts/domain/121-block-info.t:19: trailing whitespace. remote: +domain/121-block-info.t remote: scripts/domain/121-block-info.t:128: trailing whitespace. remote: +#qcow2 file start with hexadecimal:0x51 0x46 0x49 (ASCII: "QFI") remote: scripts/domain/121-block-info.t:1: new blank line at EOF. remote: scripts/domain/180-interface-parameters.t:19: trailing whitespace. remote: +domain/180-interface-parameters.t - test interface set/get remote: scripts/domain/180-interface-parameters.t:59: trailing whitespace. remote: +my %params = (Sys::Virt::Domain::BANDWIDTH_IN_AVERAGE=>1000, Sys::Virt::Domain::BANDWIDTH_IN_PEAK=>1001, remote: scripts/domain/180-interface-parameters.t:60: trailing whitespace. remote: + Sys::Virt::Domain::BANDWIDTH_IN_BURST=>1002, Sys::Virt::Domain::BANDWIDTH_OUT_AVERAGE=>1003, remote: scripts/domain/301-migration-max-speed.t:19: trailing whitespace. remote: +domain/301-migrate-max-speed.t - test migrate max speed set/get remote: scripts/domain/301-migration-max-speed.t:1: new blank line at EOF. remote: error: hook declined to update refs/heads/master To ssh://libvirt.org/git//libvirt-tck.git ! [remote rejected] master -> master (hook declined) You can set up git to refuse bad whitespace locally, to make it easier for others to not have to clean up your patches later. -- Eric Blake eblake redhat com +1-919-301-3266 Libvirt virtualization library http://libvirt.org

Get it, very thanks! ----- Original Message -----
From: "Eric Blake" <eblake@redhat.com> Cc: "Daniel P. Berrange" <berrange@redhat.com>, "Zhe Peng" <zpeng@redhat.com>, libvir-list@redhat.com Sent: Wednesday, May 15, 2013 1:01:24 AM Subject: Re: [libvirt] [libvirt-tck PATCH v2 3/3] add new script for migration max speed
On 05/14/2013 10:58 AM, Eric Blake wrote:
On 05/14/2013 08:50 AM, Daniel P. Berrange wrote:
On Fri, May 10, 2013 at 03:17:54PM +0800, Zhe Peng wrote:
new script for migrate max speed APIs dom->migrate_get_max_speed dom->migrate_set_max_speed --- scripts/domain/301-migration-max-speed.t | 64 ++++++++++++++++++++++++++++ 1 files changed, 64 insertions(+), 0 deletions(-) create mode 100644 scripts/domain/301-migration-max-speed.t
ACK
All three patches pushed now.
Minor correction - my attempt to push was rejected until I touched up your patch to fix these whitespace problems:
Compressing objects: 100% (15/15), done. Writing objects: 100% (15/15), 4.29 KiB, done. Total 15 (delta 10), reused 0 (delta 0) remote: scripts/domain/121-block-info.t:19: trailing whitespace. remote: +domain/121-block-info.t remote: scripts/domain/121-block-info.t:128: trailing whitespace. remote: +#qcow2 file start with hexadecimal:0x51 0x46 0x49 (ASCII: "QFI") remote: scripts/domain/121-block-info.t:1: new blank line at EOF. remote: scripts/domain/180-interface-parameters.t:19: trailing whitespace. remote: +domain/180-interface-parameters.t - test interface set/get remote: scripts/domain/180-interface-parameters.t:59: trailing whitespace. remote: +my %params = (Sys::Virt::Domain::BANDWIDTH_IN_AVERAGE=>1000, Sys::Virt::Domain::BANDWIDTH_IN_PEAK=>1001, remote: scripts/domain/180-interface-parameters.t:60: trailing whitespace. remote: + Sys::Virt::Domain::BANDWIDTH_IN_BURST=>1002, Sys::Virt::Domain::BANDWIDTH_OUT_AVERAGE=>1003, remote: scripts/domain/301-migration-max-speed.t:19: trailing whitespace. remote: +domain/301-migrate-max-speed.t - test migrate max speed set/get remote: scripts/domain/301-migration-max-speed.t:1: new blank line at EOF. remote: error: hook declined to update refs/heads/master To ssh://libvirt.org/git//libvirt-tck.git ! [remote rejected] master -> master (hook declined)
You can set up git to refuse bad whitespace locally, to make it easier for others to not have to clean up your patches later.
-- Eric Blake eblake redhat com +1-919-301-3266 Libvirt virtualization library http://libvirt.org
-- Best Regards Zhe Peng

On Fri, May 10, 2013 at 03:17:52PM +0800, Zhe Peng wrote:
new script for block APIs dom->block_resize dom->get_block_info dom->block_peek --- scripts/domain/121-block-info.t | 137 +++++++++++++++++++++++++++++++++++++++ 1 files changed, 137 insertions(+), 0 deletions(-) create mode 100644 scripts/domain/121-block-info.t
ACK Daniel -- |: http://berrange.com -o- http://www.flickr.com/photos/dberrange/ :| |: http://libvirt.org -o- http://virt-manager.org :| |: http://autobuild.org -o- http://search.cpan.org/~danberr/ :| |: http://entangle-photo.org -o- http://live.gnome.org/gtk-vnc :|
participants (3)
-
Daniel P. Berrange
-
Eric Blake
-
Zhe Peng