view release on metacpan or  search on metacpan

t/ConnectProperties.t  view on Meta::CPAN

      ([$obj1,'myprop-one'],
       [$obj2,'myprop-one', func_in => sub { @saw_args = @_; return @_ } ]);
  $obj1->set('myprop-one',0);
  is_deeply (\@saw_args, [0]);
}

#-----------------------------------------------------------------------------
# func_out

{
  my $obj1 = Foo->new;
  my $obj2 = Foo->new;
  my @saw_args;
  Glib::Ex::ConnectProperties->new
      ([$obj1,'mystring'],
       [$obj2,'mystring', func_out => sub { @saw_args = @_; return @_ } ]);
  $obj2->set('mystring','abc');
  is_deeply (\@saw_args, ['abc']);
}

#-----------------------------------------------------------------------------
# hash_in, hash_out

{
  my $obj1 = Foo->new (mystring => 'a');
  my $obj2 = Foo->new;
  Glib::Ex::ConnectProperties->new
      ([$obj1,'mystring'],
       [$obj2,'mystring',
        hash_in  => { 'a' => 'x', 'b' => 'y' },
        hash_out => { 'x' => 'a', 'y' => 'b' } ]);
  is ($obj1->get('mystring'), 'a');
  is ($obj2->get('mystring'), 'x');

  $obj1->set('mystring','b');
  is ($obj1->get('mystring'), 'b');
  is ($obj2->get('mystring'), 'y');

  $obj2->set('mystring','x');
  is ($obj1->get('mystring'), 'a');
  is ($obj2->get('mystring'), 'x');

  $obj2->set('mystring','z');
  is ($obj1->get('mystring'), undef);
  is ($obj2->get('mystring'), 'z');
}

#-----------------------------------------------------------------------------
# weaken

{
  my $obj1 = Foo->new (myprop_one => 1, myprop_two => 1);
  my $obj2 = Foo->new (myprop_one => 0, myprop_two => 0);
  my $conn = Glib::Ex::ConnectProperties->new ([$obj1,'myprop-one'],
                                               [$obj2,'myprop-two']);
  require Scalar::Util;

  my $weak_obj1 = $obj1;
  Scalar::Util::weaken ($weak_obj1);
  $obj1 = undef;
  is ($weak_obj1, undef, 'obj1 not kept alive');

  my $weak_obj2 = $obj2;
  Scalar::Util::weaken ($weak_obj2);
  $obj2 = undef;
  is ($weak_obj2, undef, 'obj2 not kept alive');

  Scalar::Util::weaken ($conn);
  is ($conn, undef, 'conn garbage collected when none left');
}

{
  my $obj1 = Foo->new (myprop_one => 1, myprop_two => 0);
  my $obj2 = Foo->new (myprop_one => 0, myprop_two => 1);
  my $conn = Glib::Ex::ConnectProperties->new ([$obj1,'myprop-one'],
                                               [$obj2,'myprop-two']);

  $obj1 = undef;
  $obj2->set (myprop_two=>0);
  is (scalar @{$conn->{'array'}}, 1,
      'notice linked object gone');
}

{
  my $obj1 = Foo->new (myprop_one => 1, myprop_two => 1);
  my $obj2 = Foo->new (myprop_one => 0, myprop_two => 0);
  my $conn = Glib::Ex::ConnectProperties->new ([$obj1,'myprop-one'],
                                               [$obj2,'myprop-two',
                                                write_only => 1]);
  require Scalar::Util;

  my $weak_obj1 = $obj1;
  Scalar::Util::weaken ($weak_obj1);
  $obj1 = undef;
  is ($weak_obj1, undef, 'obj1 not kept alive');

  Scalar::Util::weaken ($conn);
  is ($conn, undef, 'conn garbage collected when last readable gone');
}

#-----------------------------------------------------------------------------
# write-only

{
  my $obj1 = Foo->new;
  my $obj2 = Foo->new;
  my $obj3 = Foo->new; $obj3->{'readonly-float'} = 999;
  Glib::Ex::ConnectProperties->new ([$obj1,'writeonly-double'],
                                    [$obj2,'writeonly-double'],
                                    [$obj3,'readonly-float']);
  is ($obj1->{'writeonly_double'}, 999,
      'obj1 writeonly-double set initially');
  is ($obj2->{'writeonly_double'}, 999,
      'obj2 writeonly-double set initially');
}

{
  my $obj1 = Foo->new;
  my $obj2 = Foo->new;
  Glib::Ex::ConnectProperties->new ([$obj1,'writeonly-double'],
                                    [$obj2,'readonly-float']);
  $obj2->{'readonly-float'} = 999;
  $obj2->notify ('readonly-float');
  is ($obj1->{'writeonly_double'}, 999,
      'writeonly-double set by notify');
}

SKIP: {
  Glib::ParamSpec->can('value_validate')
      or skip 'due to value_validate() not available', 1;
  my $obj1 = Foo->new; $obj1->{'readonly-float'} = 1500;
  my $obj2 = Foo->new;
  Glib::Ex::ConnectProperties->new ([$obj1,'readonly-float'],
                                    [$obj2,'writeonly-double']);
  is ($obj2->{'writeonly_double'}, 1000,
      'obj1 writeonly-double set initially with value_validate clamp');
}

#-----------------------------------------------------------------------------
# strv

{
  my $obj1 = Foo->new;
  my $obj2 = Foo->new;
  Glib::Ex::ConnectProperties->new ([$obj1,'mystrv'],
                                    [$obj2,'mystrv']);
  is_deeply ($obj1->get('mystrv'), undef);
  $obj1->set (mystrv => ['hello', 'world']);
  is_deeply ($obj1->get('mystrv'), ['hello', 'world']);
  is_deeply ($obj2->get('mystrv'), ['hello', 'world']);
}

{
  my $obj1 = Foo->new (mystrv => ['initial', 'one']);
  my $obj2 = Foo->new (mystrv => ['blah', 'blah']);