From 60b6eb757922d7d755c2bfaa629362ff36c42556 Mon Sep 17 00:00:00 2001
From: Eelco Dolstra <eelco.dolstra@logicblox.com>
Date: Mon, 10 Jan 2011 14:41:16 +0000
Subject: [PATCH] * Add a method Machine::sleep to sleep N seconds in virtual
 (guest)   time rather than host real time.

svn path=/nixos/trunk/; revision=25491
---
 lib/test-driver/Machine.pm | 29 ++++++++++++++++++++---------
 tests/avahi.nix            |  2 +-
 tests/firefox.nix          |  4 ++--
 tests/kde4.nix             |  2 +-
 tests/login.nix            |  8 ++++----
 tests/quake3.nix           |  6 +++---
 tests/trac.nix             |  2 +-
 7 files changed, 32 insertions(+), 21 deletions(-)

diff --git a/lib/test-driver/Machine.pm b/lib/test-driver/Machine.pm
index 5d8d967431c4..81d96ee81e1a 100644
--- a/lib/test-driver/Machine.pm
+++ b/lib/test-driver/Machine.pm
@@ -467,10 +467,12 @@ sub screenshot {
 # testing the existence of /tmp/.X11-unix/X0 is insufficient.
 sub waitForX {
     my ($self, $regexp) = @_;
-    retry sub {
-        my ($status, $out) = $self->execute("xwininfo -root > /dev/null 2>&1");
-        return 1 if $status == 0;
-    }
+    $self->nest("waiting for the X11 server", sub {
+        retry sub {
+            my ($status, $out) = $self->execute("xwininfo -root > /dev/null 2>&1");
+            return 1 if $status == 0;
+        }
+    });
 }
 
 
@@ -484,12 +486,14 @@ sub getWindowNames {
 
 sub waitForWindow {
     my ($self, $regexp) = @_;
-    retry sub {
-        my @names = $self->getWindowNames;
-        foreach my $n (@names) {
-            return 1 if $n =~ /$regexp/;
+    $self->nest("waiting for a window to appear", sub {
+        retry sub {
+            my @names = $self->getWindowNames;
+            foreach my $n (@names) {
+                return 1 if $n =~ /$regexp/;
+            }
         }
-    }
+    });
 }
 
 
@@ -518,4 +522,11 @@ sub sendChars {
 }
 
 
+# Sleep N seconds (in virtual guest time, not real time).
+sub sleep {
+    my ($self, $time) = @_;
+    $self->succeed("sleep $time");
+}
+
+
 1;
diff --git a/tests/avahi.nix b/tests/avahi.nix
index 2bf811b5cb3c..9aac6fe2d212 100644
--- a/tests/avahi.nix
+++ b/tests/avahi.nix
@@ -46,7 +46,7 @@ with pkgs;
 
        # More DNS-SD.
        $one->execute("avahi-publish -s \"This is a test\" _test._tcp 123 one=1 &");
-       sleep 5;
+       $one->sleep(5);
        print STDERR
         $two->mustSucceed("avahi-browse -r -t _test._tcp | tee out");
        $two->mustSucceed("test `wc -l < out` -gt 0");
diff --git a/tests/firefox.nix b/tests/firefox.nix
index 6bc202de84bf..7e1e192c8084 100644
--- a/tests/firefox.nix
+++ b/tests/firefox.nix
@@ -13,8 +13,8 @@
     ''
       $machine->waitForX;
       $machine->execute("firefox file://${pkgs.valgrind}/share/doc/valgrind/html/index.html &");
-      $machine->waitForWindow(/Valgrind.*Shiretoko/);
-      sleep 40; # wait until Firefox has finished loading the page
+      $machine->waitForWindow(qr/Valgrind/);
+      $machine->sleep(40); # wait until Firefox has finished loading the page
       $machine->screenshot("screen");
     '';
   
diff --git a/tests/kde4.nix b/tests/kde4.nix
index 2460bb27265e..dd8b84ff3879 100644
--- a/tests/kde4.nix
+++ b/tests/kde4.nix
@@ -45,7 +45,7 @@
       $machine->waitForWindow(qr/messages.*KWrite/);
       $machine->waitForWindow(qr/Valgrind.*Konqueror/);
 
-      sleep 5;
+      $machine->sleep(5);
       
       $machine->screenshot("screen");
     '';
diff --git a/tests/login.nix b/tests/login.nix
index 944d9932fcc9..cfc0b6c8f68a 100644
--- a/tests/login.nix
+++ b/tests/login.nix
@@ -16,7 +16,7 @@
           $machine->waitForJob("tty1");
           $machine->sendChars("alice\n");
           $machine->waitUntilSucceeds("pgrep login");
-          $machine->execute("sleep 2"); # urgh: wait for `Password:'
+          $machine->sleep(2); # urgh: wait for `Password:'
           $machine->sendChars("foobar\n");
           $machine->waitUntilSucceeds("pgrep -u alice bash");
           $machine->sendChars("touch done\n");
@@ -27,7 +27,7 @@
       subtest "virtual console switching", sub {
           $machine->sendKeys("alt-f10");
           $machine->waitUntilSucceeds("[ \$(fgconsole) = 10 ]");
-          $machine->execute("sleep 2"); # allow fbcondecor to catch up (not important)
+          $machine->sleep(2); # allow fbcondecor to catch up (not important)
           $machine->screenshot("syslog");
       };
 
@@ -35,10 +35,10 @@
       # ownership as needed.
       subtest "device permissions", sub {
           $machine->succeed("chvt 1");
-          $machine->execute("sleep 1"); # urgh
+          $machine->sleep(1); # urgh
           $machine->succeed("getfacl /dev/snd/timer | grep -q alice");
           $machine->succeed("chvt 2");
-          $machine->execute("sleep 1"); # urgh
+          $machine->sleep(1); # urgh
           $machine->fail("getfacl /dev/snd/timer | grep -q alice");
       };
 
diff --git a/tests/quake3.nix b/tests/quake3.nix
index f684b9a09cba..c21a1506b650 100644
--- a/tests/quake3.nix
+++ b/tests/quake3.nix
@@ -56,18 +56,18 @@ rec {
       $server->waitUntilSucceeds("grep -q 'Foo.*entered the game' /tmp/log");
       $server->waitUntilSucceeds("grep -q 'Bar.*entered the game' /tmp/log");
 
-      sleep 10; # wait for a while to get a nice screenshot
+      $server->sleep(10); # wait for a while to get a nice screenshot
 
       $client1->block();
 
-      sleep 20;
+      $server->sleep(20);
 
       $client1->screenshot("screen1");
       $client2->screenshot("screen2");
 
       $client1->unblock();
 
-      sleep 10;
+      $server->sleep(10);
 
       $client1->screenshot("screen3");
       $client2->screenshot("screen4");
diff --git a/tests/trac.nix b/tests/trac.nix
index a6a7756c5aef..daf59a6f29da 100644
--- a/tests/trac.nix
+++ b/tests/trac.nix
@@ -69,7 +69,7 @@
       $client->waitForX;
       $client->execute("konqueror http://webserver/projects/test &");
       $client->waitForWindow(qr/Test.*Konqueror/);
-      sleep 30; # loading takes a long time
+      $client->sleep(30); # loading takes a long time
       
       $client->screenshot("screen");
     '';