include APIs
dom->block_resize
dom->get_block_info
dom->block_peek
dom->get_interface_parameters
dom->migrate_get_max_speed
dom->set_interface_parameters
con->is_alive
---
scripts/domain/180-interface-parameters.t | 173 +++++++++++++++++++++++++++++
1 files changed, 173 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..6b30a30
--- /dev/null
+++ b/scripts/domain/180-interface-parameters.t
@@ -0,0 +1,173 @@
+# -*- perl -*-
+#
+# Copyright (C) 2012 Red Hat, Inc.
+# Copyright (C) 2012 Kyla Zhang <weizhan@xxxxxxxxxx>
+#
+# 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->block_resize
+dom->get_block_info
+dom->block_peek
+dom->get_interface_parameters
+dom->migrate_get_max_speed
+dom->set_interface_parameters
+con->is_alive
+
+=cut
+
+use strict;
+use warnings;
+
+use Test::More tests => 39;
+
+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();
+diag "$xml";
+
+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");
+
+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");
+
+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 "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");
+
+
+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
--
libvir-list mailing list
libvir-list@xxxxxxxxxx
https://www.redhat.com/mailman/listinfo/libvir-list