diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/t/800-explicit-close.t | 51 | ||||
| -rw-r--r-- | perl/typemap | 17 |
2 files changed, 62 insertions, 6 deletions
diff --git a/perl/t/800-explicit-close.t b/perl/t/800-explicit-close.t new file mode 100644 index 00000000..81851680 --- /dev/null +++ b/perl/t/800-explicit-close.t @@ -0,0 +1,51 @@ +# libguestfs Perl bindings -*- perl -*- +# Copyright (C) 2010 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., 675 Mass Ave, Cambridge, MA 02139, USA. + +# Test implicit vs explicit closes of the handle (RHBZ#602592). + +use strict; +use warnings; +use Test::More tests => 10; + +use Sys::Guestfs; + +my $g; + +$g = Sys::Guestfs->new (); +ok($g); +$g->close (); # explicit close +ok($g); +undef $g; # implicit close - should be no error/warning +ok(1); + +# Expect an error if we call a method on a closed handle. +$g = Sys::Guestfs->new (); +ok($g); +$g->close (); +ok($g); +eval { $g->set_memsize (512); }; +ok($g); +ok($@ && $@ =~ /closed handle/); +undef $g; +ok(1); + +# Try calling a method without a blessed reference. This should +# give a different error. +eval { Sys::Guestfs::set_memsize (undef, 512); }; +ok ($@ && $@ =~ /not.*blessed/); +eval { Sys::Guestfs::set_memsize (42, 512); }; +ok ($@ && $@ =~ /not.*blessed/); diff --git a/perl/typemap b/perl/typemap index 752ca0d7..d978e601 100644 --- a/perl/typemap +++ b/perl/typemap @@ -6,13 +6,18 @@ int64_t T_IV INPUT O_OBJECT_guestfs_h - if (sv_isobject ($arg) && SvTYPE (SvRV ($arg)) == SVt_PVMG) - $var = ($type) SvIV ((SV *) SvRV ($arg)); - else { - warn (\"${Package}::$func_name(): $var is not a blessed SV reference\"); - XSRETURN_UNDEF; + if (sv_isobject ($arg) && sv_derived_from ($arg, \"Sys::Guestfs\") && + SvTYPE ($arg) == SVt_RV && + SvTYPE (SvRV ($arg)) == SVt_PVHV) { + HV *hv = (HV *) SvRV ($arg); + SV **svp = hv_fetch (hv, \"_g\", 2, 0); + if (svp == NULL) + croak (\"${Package}::$func_name(): called on a closed handle\"); + $var = ($type) SvIV (*svp); + } else { + croak (\"${Package}::$func_name(): $var is not a blessed HV reference\"); } OUTPUT O_OBJECT_guestfs_h - sv_setref_pv ($arg, "Sys::Guestfs", (void *) $var); + sv_setiv ($arg, PTR2IV ($var)); |