diff --git a/perl/t/025-create-flags.t b/perl/t/030-create-flags.t similarity index 100% rename from perl/t/025-create-flags.t rename to perl/t/030-create-flags.t diff --git a/perl/t/027-create-multiple.t b/perl/t/040-create-multiple.t similarity index 100% rename from perl/t/027-create-multiple.t rename to perl/t/040-create-multiple.t diff --git a/perl/t/030-config.t b/perl/t/060-handle-properties.t similarity index 100% rename from perl/t/030-config.t rename to perl/t/060-handle-properties.t diff --git a/perl/t/060-readdir.t b/perl/t/060-readdir.t deleted file mode 100644 index 6b2ab1331..000000000 --- a/perl/t/060-readdir.t +++ /dev/null @@ -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"); diff --git a/perl/t/050-lvcreate.t b/perl/t/100-launch.t similarity index 69% rename from perl/t/050-lvcreate.t rename to perl/t/100-launch.t index 465a479d3..853c91292 100644 --- a/perl/t/050-lvcreate.t +++ b/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); diff --git a/perl/t/400-events.t b/perl/t/410-close-event.t similarity index 100% rename from perl/t/400-events.t rename to perl/t/410-close-event.t diff --git a/perl/t/420-log-messages.t b/perl/t/420-log-messages.t new file mode 100644 index 000000000..aa323a621 --- /dev/null +++ b/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); diff --git a/perl/t/005-pod.t b/perl/t/910-pod.t similarity index 100% rename from perl/t/005-pod.t rename to perl/t/910-pod.t diff --git a/perl/t/006-pod-coverage.t b/perl/t/920-pod-coverage.t similarity index 100% rename from perl/t/006-pod-coverage.t rename to perl/t/920-pod-coverage.t