perl: Almost standardize the Perl tests.

This needs more work, but brings them mostly up to the same
standard form as the OCaml tests and the test documentation.

perl/t/060-readdir.t

@@ -1,61 +0,0 @@
-# libguestfs Perl bindings -*- perl -*-
-# Copyright (C) 2009 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;
-use warnings;
-use Test::More tests => 12;
-
-use Sys::Guestfs;
-
-my $g = Sys::Guestfs->new ();
-ok ($g);
-open FILE, ">test.img";
-truncate FILE, 10*1024*1024;
-close FILE;
-ok (1);
-
-$g->add_drive ("test.img");
-ok (1);
-
-$g->launch ();
-ok (1);
-
-$g->part_disk ("/dev/sda", "mbr");
-ok (1);
-$g->mkfs ("ext2", "/dev/sda1");
-ok (1);
-$g->mount ("/dev/sda1", "/");
-ok (1);
-$g->mkdir ("/p");
-ok (1);
-$g->touch ("/q");
-ok (1);
-
-my @dirs = $g->readdir ("/");
-@dirs = sort { $a->{name} cmp $b->{name} } @dirs;
-foreach (@dirs) {
-  print "$_->{name} $_->{ino} $_->{ftyp}\n";
-}
-ok (1);
-
-$g->shutdown ();
-ok (1);
-
-undef $g;
-ok (1);
-
-unlink ("test.img");

perl/t/100-launch.t

@@ -1,5 +1,5 @@
 # libguestfs Perl bindings -*- perl -*-
-# Copyright (C) 2009 Red Hat Inc.
+# Copyright (C) 2009-2013 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
@@ -17,7 +17,7 @@
 
 use strict;
 use warnings;
-use Test::More tests => 11;
+use Test::More tests => 26;
 
 use Sys::Guestfs;
 
@@ -49,6 +49,29 @@ if (@lvs != 2 || $lvs[0] ne "/dev/VG/LV1" || $lvs[1] ne "/dev/VG/LV2") {
 }
 ok (1);
 
+$g->mkfs ("ext2", "/dev/VG/LV1");
+ok (1);
+$g->mount ("/dev/VG/LV1", "/");
+ok (1);
+$g->mkdir ("/p");
+ok (1);
+$g->touch ("/q");
+ok (1);
+
+my @dirs = $g->readdir ("/");
+@dirs = sort { $a->{name} cmp $b->{name} } @dirs;
+ok (@dirs == 5);
+ok ($dirs[0]{name} eq ".");
+ok ($dirs[0]{ftyp} eq "d");
+ok ($dirs[1]{name} eq "..");
+ok ($dirs[1]{ftyp} eq "d");
+ok ($dirs[2]{name} eq "lost+found");
+ok ($dirs[2]{ftyp} eq "d");
+ok ($dirs[3]{name} eq "p");
+ok ($dirs[3]{ftyp} eq "d");
+ok ($dirs[4]{name} eq "q");
+ok ($dirs[4]{ftyp} eq "r");
+
 $g->shutdown ();
 ok (1);
 

perl/t/420-log-messages.t

@@ -0,0 +1,72 @@
+# libguestfs Perl bindings -*- perl -*-
+# Copyright (C) 2011 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;
+use warnings;
+use Test::More tests => 7;
+
+use Sys::Guestfs;
+
+my $g = Sys::Guestfs->new ();
+ok ($g);
+
+sub log_callback {
+    my $ev = shift;
+    my $eh = shift;
+    my $buf = shift;
+    my $array = shift;
+
+    chomp $buf if $ev == $Sys::Guestfs::EVENT_APPLIANCE;
+
+    # We don't get to see this output because it is eaten up by the
+    # test harness, but generate it anyway.
+    printf("perl event logged: event=%s eh=%d buf='%s' array=[%s]\n",
+           Sys::Guestfs->event_to_string ($ev),
+           $eh, $buf, join (", ", @$array));
+}
+
+my $close_invoked = 0;
+
+sub close_callback {
+    $close_invoked++;
+    log_callback (@_);
+}
+
+# Register an event callback for all log messages.
+my $events = $Sys::Guestfs::EVENT_APPLIANCE | $Sys::Guestfs::EVENT_LIBRARY |
+    $Sys::Guestfs::EVENT_TRACE;
+my $eh;
+$eh = $g->set_event_callback (\&log_callback, $events);
+ok ($eh >= 0);
+
+# Check that the close event is invoked.
+$g->set_event_callback (\&close_callback, $Sys::Guestfs::EVENT_CLOSE);
+ok ($eh >= 0);
+
+# Now make sure we see some messages.
+$g->set_trace (1);
+$g->set_verbose (1);
+ok (1);
+
+# Do some stuff.
+$g->add_drive_ro ("/dev/null");
+ok (1);
+
+# Close the handle.  The close callback should be invoked.
+ok ($close_invoked == 0);
+undef $g;
+ok ($close_invoked == 1);