refactor(test): ping without cache to speed it up

t/lib/Test/Ravada.pm

@@ -154,7 +154,8 @@ sub add_ubuntu_minimal_iso {
 }
 
 sub vm_names {
-    return sort keys %ARG_CREATE_DOM;
+   return (sort keys %ARG_CREATE_DOM) if wantarray;
+   confess;
 }
 
 sub create_domain {
@@ -194,7 +195,7 @@ sub create_domain {
     my %arg_create = (id_iso => $id_iso);
     $arg_create{swap} = 1024 * 1024 if $swap;
 
-    eval { $domain = $vm->create_domain(name => $name
+    { $domain = $vm->create_domain(name => $name
                     , id_owner => $user->id
                     , %arg_create
                     , active => 0
@@ -203,6 +204,7 @@ sub create_domain {
            );
     };
     is('',''.$@);
+    #    exit if time - $t0 > 9;
 
     return $domain;
 
@@ -471,7 +473,7 @@ sub _remove_old_domains_void {
 }
 
 sub _remove_old_domains_void_remote($vm) {
-    return if !$vm->ping;
+    return if !$vm->ping(undef,0);
     eval { $vm->connect };
     warn $@ if $@;
     return if !$vm->_do_is_active;
@@ -636,7 +638,7 @@ sub _remove_old_disks_void($node=undef){
 
 sub _remove_old_disks_void_remote($node) {
     confess "Remote node must be defined"   if !defined $node;
-    return if !$node->ping;
+    return if !$node->ping(undef,0);
 
     my $cmd = "rm -rfv ".$node->dir_img."/".base_domain_name().'_*';
     $node->run_command($cmd);
@@ -1143,7 +1145,7 @@ sub hibernate_node($node) {
     my $ping;
     for ( 1 .. $max_wait ) {
         diag("Waiting for node ".$node->name." to be inactive ...")  if !($_ % 10);
-        $ping = $node->ping;
+        $ping = $node->ping(undef, 0);
         last if !$ping;
         sleep 1;
     }
@@ -1166,12 +1168,12 @@ sub shutdown_node($node) {
     eval {
         $domain_node->shutdown(user => user_admin);# if !$domain_node->is_active;
     };
-    sleep 2 if !$node->ping;
+    sleep 2 if !$node->ping(undef, 0);
 
     my $max_wait = 120;
     for ( 1 .. $max_wait / 2 ) {
         diag("Waiting for node ".$node->name." to be inactive ...")  if !($_ % 10);
-        last if !$node->ping;
+        last if !$node->ping(undef, 0);
         sleep 1;
     }
     is($node->ping,0);
@@ -1197,12 +1199,12 @@ sub start_node($node) {
     $domain->start(user => user_admin, remote_ip => '127.0.0.1')  if !$domain->is_active;
 
     for ( 1 .. 60 ) {
-        last if $node->ping;
+        last if $node->ping(undef,0); # no cache
         sleep 1;
-        diag("Waiting for ping node ".$node->name." ".$node->ip." $_") if !($_ % 10);
+        diag("Waiting for ping node ".$node->name." ".$node->ip." $_");#  if !($_ % 10);
     }
 
-    is($node->ping('debug'),1,"[".$node->type."] Expecting ping node ".$node->name) or exit;
+    is($node->ping('debug',0),1,"[".$node->type."] Expecting ping node ".$node->name) or exit;
 
     for ( 1 .. 60 ) {
         my $is_active;
@@ -1433,7 +1435,7 @@ sub _do_remote_node($vm_name, $remote_config) {
     eval { $node->ping };
     is($@,'',"[$vm_name] ping ".$node->name);
 
-    if ( $node->ping && !$node->_connect_ssh() ) {
+    if ( $node->ping(undef,0) && !$node->_connect_ssh() ) {
         my $ssh;
         for ( 1 .. 60 ) {
             $ssh = $node->_connect_ssh();

t/nodes/10_basic.t

@@ -30,10 +30,13 @@ sub test_reuse_vm($node) {
     is($clone1->_vm, $clone2->_vm, $clone1->_vm->name);
     is($clone1->_vm->id, $clone2->_vm->id);
 
+    is($clone1->list_instances,1);
+
     $clone1->migrate($node);
     is($clone1->_data('id_vm'), $node->id);
     $clone2->migrate($node);
     is($clone2->_data('id_vm'), $node->id);
+    is($clone1->list_instances,2);
 
     is($clone1->_vm, $clone2->_vm);
     is($clone1->_vm, $clone2->_vm);
@@ -85,6 +88,7 @@ sub test_remove($clone, $node) {
         ok($out, "Expecting file '$file' in ".$node->name) or exit;
     }
 
+    is($clone->list_instances,2) or confess;
     $clone->remove(user_admin);
     for my $file ( @volumes ) {
         ok(! -e $file, "Expecting no file '$file' in localhost") or exit;
@@ -264,12 +268,23 @@ sub test_set_vm($vm, $node) {
     is($info->{bases}->{$node->id},1,$node->id." "
         .Dumper($info->{bases})) or exit;
 
+    is($base->list_instances,2) or exit;
+
     my $base_f = Ravada::Front::Domain->open($base->id);
     $info = $base_f->info(user_admin);
     is($info->{bases}->{$vm->id},1) or exit;
     is($info->{bases}->{$node->id},1) or exit;
 
+    is($base_f->list_instances,2) or exit;
+
     $base->remove(user_admin);
+    is(scalar($base->list_instances),undef);
+}
+
+sub test_instances($clone, $expected) {
+    confess;
+    my @instances = $clone->list_instances();
+    is(@instances,$expected,Dumper(\@instances)) or exit;
 }
 
 sub test_volatile($vm, $node) {
@@ -288,10 +303,13 @@ sub test_volatile($vm, $node) {
     }
     is($clones[-1]->_vm->id, $node->id);
 
+    is($clones[-1]->list_instances,1,Dumper([$clones[-1]->list_instances])) or exit;
+
     for (@clones) {
         $_->remove(user_admin);
     }
     $base->remove(user_admin);
+    is(scalar($base->list_instances),undef,Dumper([$base->list_instances])) or exit;
 }
 
 sub test_volatile_req($vm, $node) {
@@ -365,11 +383,13 @@ sub test_volatile_tmp_owner($vm, $node) {
 
 sub test_clone_remote($vm, $node) {
     my $base = create_domain($vm);
+    is($base->list_instances,1);
     $base->prepare_base(user_admin);
 
     my $bases_vm = $base->_bases_vm();
     is($bases_vm->{$vm->id},1) or exit;
     $base->set_base_vm(user => user_admin, node => $node);
+    is($base->list_instances,2);
 
     $bases_vm = $base->_bases_vm();
     is($bases_vm->{$node->id},1) or exit;
@@ -382,10 +402,14 @@ sub test_clone_remote($vm, $node) {
     );
     ok($clone->_vm->name, $node->name);
 
+    is($clone->list_instances,1);
+
     _test_old_base($base, $vm);
     _test_clones($base, $vm);
     $clone->remove(user_admin);
+    is($clone->list_instances,undef);
     $base->remove(user_admin);
+    is($base->list_instances,undef);
 }
 
 sub _test_old_base($base, $vm) {

t/nodes/50_three_nodes.t

@@ -17,26 +17,34 @@ use feature qw(signatures);
 sub test_remove($vm, $node1, $node2) {
     my $domain = create_domain($vm);
 
+    is($domain->list_instances,1);
     $domain->prepare_base(user_admin);
+    is($domain->list_instances,1);
     $domain->set_base_vm(vm => $node1, user => user_admin);
+    is($domain->list_instances,2);
     $domain->set_base_vm(vm => $node2, user => user_admin);
+    is($domain->list_instances,3);
 
     my $clone1 = $domain->clone( user => user_admin
         , name => new_domain_name
     );
+    is($clone1->list_instances,1);
     $clone1->migrate($node1);
+    is($clone1->list_instances,2);
 
     my $clone2 = $domain->clone( user => user_admin
         , name => new_domain_name
     );
     $clone2->migrate($node1);
     $clone2->migrate($node2);
+    is($clone2->list_instances,3);
 
     my @name = ( $clone1->name, $clone2->name, $domain->name);
     my @id = ( $clone1->id, $clone2->id, $domain->id);
 
     $clone1->remove(user_admin);
     $clone2->remove(user_admin);
+    is($clone2->list_instances,undef);
     $domain->remove(user_admin);
 
     for my $name (@name) {

t/vm/20_base.t

@@ -869,8 +869,6 @@ for my $vm_name ('KVM', 'Void') {
 
         test_prepare_fail($vm);
 
-        test_prepare_remove($vm);
-
         test_domain_limit_already_requested($vm_name);
 
         test_prepare_base_with_cd($vm);

t/vm/r20_rebase.t

@@ -284,7 +284,7 @@ sub _create_part($dev) {
     my ($in,$out, $err);
     for my $retry ( 1 .. 10 ) {
         run3(\@cmd, \$in, \$out, \$err);
-        last if !$err;
+        last if !$err && $err =~ /(Input\/output error|Unexpected end-of-file)/i;
         warn $err if $err && $retry>2;
         sleep 1;
     }