view release on metacpan or  search on metacpan

t/TieProperties.t  view on Meta::CPAN

# tie() no properties

diag "using tie() with no properties";
{
  my $obj = MyObjectNoProperties->new;
  my %h;
  my $tobj = tie %h, 'Glib::Ex::TieProperties', $obj;

  # scalar()
  # 5.8.2 and earlier without SCALAR method also give false for empty %h
  ok ($gobject_has_properties || ! scalar %h,
      "scalar() false, if GObject doesn't have properties");
}

#-----------------------------------------------------------------------------
# new()

diag "using new()";
{
  my $obj = MyObject->new;
  my $h = Glib::Ex::TieProperties->new($obj);

  # tied()
  is (tied(%$h)->object, $obj, 'tied()->object');
}

#-----------------------------------------------------------------------------
# new() -- weak

diag "using new() weak";
{
  my $obj = MyObject->new;
  my $h = Glib::Ex::TieProperties->new($obj, weak => 1);
  $obj = undef;

  is (tied(%$h)->object, undef, 'destroyed tied()->object');
  is ($h->{'myprop-one'}, undef, 'destroyed fetch');
  ok (eval { $h->{'myprop-one'} = 1; 1}, 'destroyed store');
  ok (! scalar %$h, 'destroyed scalar() false');
  is_deeply ([ sort grep {exists $want_props{$_}} keys %$h ],
             [ ],
             'destroyed keys');
}


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

diag "using in_object()";
{
  my $obj = MyObject->new;
  Glib::Ex::TieProperties->in_object($obj);

  my $h = $obj->{'property'};
  my $tobj = tied %$h;

  # tied()
  is (tied(%$h)->object, $obj, 'in_object() - tied()->object');

  $obj = undef;
  is (tied(%$h)->object, $obj, 'in_object() - tied()->object destroyed');
  Scalar::Util::weaken ($h);
  Scalar::Util::weaken ($tobj);
  is ($h,    undef, 'in_object() hashref gc');
  is ($tobj, undef, 'in_object() tobj gc');
}

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

diag "using in_object() with field name";
{
  my $obj = MyObject->new;
  Glib::Ex::TieProperties->in_object($obj, field=>'xyzzy');

  is ($obj->{'property'}, undef, 'in_object xyzzy - not in "property" field');

  my $h = $obj->{'xyzzy'};
  my $tobj = tied %$h;

  # tied()
  is (tied(%$h)->object, $obj, 'in_object() xyzzy - tied()->object');

  $obj = undef;
  is (tied(%$h)->object, $obj, 'in_object() xyzzy - tied()->object destroyed');
  Scalar::Util::weaken ($h);
  Scalar::Util::weaken ($tobj);
  is ($h,    undef, 'in_object() xyzzy hashref gc');
  is ($tobj, undef, 'in_object() xyzzy tobj gc');
}

exit 0;