rescue: Add an expect-driven test for the virt-rescue command.

This command was not tested at all.  As a result we didn't notice that
it was broken for a long time (RHBZ#853159).

This adds a test that drives the command through a pty.  It uses the
perl 'Expect' module, although this is not required.

4 files changed, 67 insertions, 0 deletions

diff --git a/README b/README
index 4968614e..78bae9e1 100644
--- a/README
+++ b/README
@@ -113,6 +113,9 @@ For basic functionality and the C tools:
 - netpbm, icoutils (optional)
   These programs are used to render icons from guests.
 
+- Perl Expect module (optional)
+  This is used to test virt-rescue.
+
 To build FUSE support in the core library, and guestmount:
 
 - FUSE libraries and kernel module (optional)
diff --git a/po/POTFILES b/po/POTFILES
index 8fcdafc7..129c80f9 100644
--- a/po/POTFILES
+++ b/po/POTFILES
@@ -207,6 +207,7 @@ perl/lib/Sys/Guestfs/Lib.pm
 php/extension/guestfs_php.c
 python/guestfs-py-byhand.c
 python/guestfs-py.c
+rescue/test-virt-rescue.pl
 rescue/virt-rescue.c
 resize/progress-c.c
 ruby/ext/guestfs/_guestfs.c
diff --git a/rescue/Makefile.am b/rescue/Makefile.am
index d0b23cae..6e775d09 100644
--- a/rescue/Makefile.am
+++ b/rescue/Makefile.am
@@ -18,6 +18,7 @@
 include $(top_srcdir)/subdir-rules.mk
 
 EXTRA_DIST = \
+	test-virt-rescue.pl \
 	virt-rescue.pod
 
 CLEANFILES = stamp-virt-rescue.pod
@@ -63,3 +64,11 @@ stamp-virt-rescue.pod: virt-rescue.pod
 	  --license GPLv2+ \
 	  $<
 	touch $@
+
+# Tests.
+
+TESTS_ENVIRONMENT = $(top_builddir)/run --test
+
+if ENABLE_APPLIANCE
+TESTS = test-virt-rescue.pl
+endif ENABLE_APPLIANCE
diff --git a/rescue/test-virt-rescue.pl b/rescue/test-virt-rescue.pl
new file mode 100755
index 00000000..7767ab01
--- /dev/null
+++ b/rescue/test-virt-rescue.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl -w
+# libguestfs
+# Copyright (C) 2012 Red Hat Inc.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use strict;
+
+# This test requires the perl 'Expect' module.  If it doesn't
+# exist, skip the test.
+eval "use Expect";
+
+unless (exists $INC{"Expect.pm"}) {
+    print STDERR "$0: test skipped because there is no perl Expect module\n";
+    exit 77
+}
+
+# Run virt-rescue and make sure we get to the rescue prompt.
+my $exp = Expect->spawn ("./virt-rescue", "--scratch")
+    or die "$0: Expect could not spawn virt-rescue: $!\n";
+
+my $timeout = 5 * 60;
+my $r;
+$r = $exp->expect ($timeout, '><rescue>');
+
+unless (defined $r) {
+    die "$0: virt-rescue did not reach the '><rescue>' prompt within $timeout seconds\n";
+}
+
+# Send a simple command; expect to get back to the prompt.
+$exp->send ("ls -1\n");
+
+$timeout = 60;
+$r = $exp->expect ($timeout, '><rescue>');
+
+unless (defined $r) {
+    die "$0: virt-rescue did not return to the prompt after sending a command\n";
+}
+
+# Check virt-rescue shell exits when we send the 'exit' command.
+$exp->send ("exit\n");
+$exp->soft_close ();