Glib-Object-Introspection

 view release on metacpan or  search on metacpan

t/boxed.t  view on Meta::CPAN

#!/usr/bin/env perl

BEGIN { require './t/inc/setup.pl' };

use strict;
use warnings;
use Scalar::Util qw/weaken/;

plan tests => 47;

# Use the provided constructor.
{
  my $boxed = GI::BoxedStruct->new;
  isa_ok ($boxed, 'GI::BoxedStruct');
  is ($boxed->long_, 0);
  is ($boxed->g_strv, undef);
  is ($boxed->long_ (42), 0);
  $boxed->inv;
  weaken $boxed;
  is ($boxed, undef);
}

# Use our generic constructor.
{
  my $boxed = Glib::Boxed::new ('GI::BoxedStruct', {long_ => 42});
  isa_ok ($boxed, 'GI::BoxedStruct');
  is ($boxed->long_, 42);
  is ($boxed->g_strv, undef);
  $boxed->inv;

t/boxed.t  view on Meta::CPAN

}

SKIP: {
  skip 'new stuff', 6
    unless check_gi_version (0, 12, 0);
  my $boxed = GI::BoxedStruct::returnv ();
  isa_ok ($boxed, 'GI::BoxedStruct');
  is ($boxed->long_, 42);
  is_deeply ($boxed->g_strv, [qw/0 1 2/]);
  $boxed->inv;
  weaken $boxed;
  is ($boxed, undef);
  # make sure we haven't destroyed the static object
  isa_ok (GI::BoxedStruct::returnv (), 'GI::BoxedStruct');
  isa_ok (GI::BoxedStruct::returnv ()->copy, 'GI::BoxedStruct');
}

SKIP: {
  skip 'new stuff', 5
    unless check_gi_version (0, 12, 0);
  my $boxed = GI::BoxedStruct::out ();
  isa_ok ($boxed, 'GI::BoxedStruct');
  is ($boxed->long_, 42);
  # $boxed->g_strv contains garbage
  weaken $boxed;
  is ($boxed, undef);
  # make sure we haven't destroyed the static object
  isa_ok (GI::BoxedStruct::out (), 'GI::BoxedStruct');
  isa_ok (GI::BoxedStruct::out ()->copy, 'GI::BoxedStruct');
}

SKIP: {
  skip 'new stuff', 4
    unless check_gi_version (0, 12, 0);
  my $boxed_out = GI::BoxedStruct::out ();
  my $boxed = GI::BoxedStruct::inout ($boxed_out);
  isa_ok ($boxed, 'GI::BoxedStruct');
  is ($boxed->long_, 0);
  is ($boxed_out->long_, 42);
  # $boxed->g_strv contains garbage
  weaken $boxed;
  is ($boxed, undef);
}

# --------------------------------------------------------------------------- #

SKIP: {
  skip 'new stuff', 5
    unless check_gi_version (0, 12, 0);
  my $boxed = Regress::TestSimpleBoxedA::const_return ();
  isa_ok ($boxed, 'Regress::TestSimpleBoxedA');
  isa_ok ($boxed, 'Glib::Boxed');
  my $copy = $boxed->copy;
  ok ($boxed->equals ($copy));
  weaken $boxed;
  is ($boxed, undef);
  weaken $copy;
  is ($copy, undef);
}

{
  my $boxed = Regress::TestBoxed->new;
  isa_ok ($boxed, 'Regress::TestBoxed');
  isa_ok ($boxed, 'Glib::Boxed');
  my $copy = $boxed->copy;
  isa_ok ($boxed, 'Regress::TestBoxed');
  isa_ok ($boxed, 'Glib::Boxed');
  ok ($boxed->equals ($copy));
  weaken $boxed;
  is ($boxed, undef);
  weaken $copy;
  is ($copy, undef);

  $boxed = Regress::TestBoxed->new_alternative_constructor1 (23);
  isa_ok ($boxed, 'Regress::TestBoxed');
  isa_ok ($boxed, 'Glib::Boxed');
  weaken $boxed;
  is ($boxed, undef);

  $boxed = Regress::TestBoxed->new_alternative_constructor2 (23, 42);
  isa_ok ($boxed, 'Regress::TestBoxed');
  isa_ok ($boxed, 'Glib::Boxed');
  weaken $boxed;
  is ($boxed, undef);

  $boxed = Regress::TestBoxed->new_alternative_constructor3 ("perl");
  isa_ok ($boxed, 'Regress::TestBoxed');
  isa_ok ($boxed, 'Glib::Boxed');
  weaken $boxed;
  is ($boxed, undef);
}

t/objects.t  view on Meta::CPAN

#!/usr/bin/env perl

BEGIN { require './t/inc/setup.pl' };

use strict;
use warnings;
use Scalar::Util qw/weaken/;

plan tests => 41;

my $obj = Regress::TestObj->constructor;
isa_ok ($obj, 'Regress::TestObj');
isa_ok ($obj, 'Glib::Object');

$obj = Regress::TestObj->new ($obj);
isa_ok ($obj, 'Regress::TestObj');
isa_ok ($obj, 'Glib::Object');

weaken $obj;
is ($obj, undef);

$obj = Regress::TestObj->new_from_file ($0);
isa_ok ($obj, 'Regress::TestObj');
isa_ok ($obj, 'Glib::Object');

$obj->set_bare (Regress::TestObj->constructor);
is ($obj->instance_method, -1);
is (Regress::TestObj::static_method (23), 23);
$obj->forced_method;

t/objects.t  view on Meta::CPAN

ok ($wi->get_testbool);
is (Regress::TestWi8021x::static_method (23), 46);

# floating objects
SKIP: {
  my $fl = Regress::TestFloating->new;
  isa_ok ($fl, 'Regress::TestFloating');
  isa_ok ($fl, 'Glib::InitiallyUnowned');
  isa_ok ($fl, 'Glib::Object');

  weaken $fl;
  is ($fl, undef);
}

t/vfunc-ref-counting.t  view on Meta::CPAN

  WeakFloater => Glib::TRUE,
  StrongNonFloater => Glib::FALSE,
  StrongFloater => Glib::TRUE,
);

# Test that the invocant is not leaked.
foreach my $package (@packages) {
  {
    my $nf = $package->new;
    $nf->get_ref_info_for_vfunc_return_object_transfer_full;
    Scalar::Util::weaken ($nf);
    is ($nf, undef, "no leak for $package");
  }
}

# Test transfer-none&return/out semantics.
foreach my $package (@packages) {
  local $SIG{__WARN__} = $package_to_warner{$package};
  foreach my $method (qw/get_ref_info_for_vfunc_return_object_transfer_none
                         get_ref_info_for_vfunc_out_object_transfer_none/)
  {

t/vfunc-ref-counting.t  view on Meta::CPAN

}
{
  package WeakNonFloater;
  use Glib::Object::Subclass 'Base';

  sub _create {
    NonFloatingObjectSubclass->new;
  }
  sub _store {
    my ($self, $o) = @_;
    Scalar::Util::weaken ($self->{_ref} = $o);
  }
  sub _retrieve {
    my ($self) = @_;
    $self->{_ref};
  }
}
{
  package WeakFloater;
  use Glib::Object::Subclass 'Base';

  sub _create {
    FloatingObjectSubclass->new;
  }
  sub _store {
    my ($self, $o) = @_;
    Scalar::Util::weaken ($self->{_ref} = $o);
  }
  sub _retrieve {
    my ($self) = @_;
    $self->{_ref};
  }
}
{
  package StrongNonFloater;
  use Glib::Object::Subclass 'Base';