# # $Header: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/t/c.t,v 1.2 2003/12/10 20:19:10 rwmcfa1 Exp $ # use strict; use warnings; ######################### use Test::More tests => 13; BEGIN { use_ok('Glib') }; ######################### $@ = undef; eval { Glib::Type->register_enum ('TestEnum', qw/value-one value-two value-three/, [ 'value-four', 42 ], 'value-five', ['value-six']); 1; }; ok (!$@, 'register_enum'); $@ = undef; eval { Glib::Type->register_flags ('TestFlags', qw/value-one value-two value-three/, [ 'value-four', 1 << 16 ], 'value-five', ['value-six']); 1; }; ok (!$@, 'register_flags'); $@ = undef; eval { Glib::Type->register_enum ('TestEnum1', qw/value-one value-two value-three/, [ 'value-four', 42 ], 'value-five', []); 1; }; ok ($@, 'failed register_enum with empty array ref'); $@ = undef; eval { Glib::Type->register_enum ('TestEnum2', qw/value-one value-two value-three/, [ 'value-four', 42 ], 'value-five', undef); 1; }; ok ($@, 'failed register_enum with undef'); $@ = undef; eval { Glib::Type->register_flags ('TestFlags1', qw/value-one value-two value-three/, [ 'value-four', 1 << 16 ], 'value-five', []); 1; }; ok ($@, 'failed register_flag with empty array ref'); $@ = undef; eval { Glib::Type->register_flags ('TestFlags2', qw/value-one value-two value-three/, [ 'value-four', 1 << 16 ], 'value-five', undef); 1; }; ok ($@, 'failed register_flag with undef'); package Tester; use Test::More; Glib::Type->register ( Glib::Object::, __PACKAGE__, signals => { sig1 => { class_closure => sub { is ($_[1], 'value-two', 'closure enum'); ok ($_[2]->isa ('TestFlags'), 'closure flags'); }, return_type => undef, param_types => [ 'TestEnum', 'TestFlags' ], }, }, properties => [ Glib::ParamSpec->enum ( 'some_enum', 'Some Enum Property', 'This is a test of a perl created enum', 'TestEnum', 'value-one', [qw/readable writable/], ), Glib::ParamSpec->flags ( 'some_flags', 'Some Flags Property', 'This is a test of a perl created flags', 'TestFlags', [qw/value-one value-five/], [qw/readable writable/], ) ]); sub GET_PROPERTY { $_[0]->{$_[1]->get_name}; } sub SET_PROPERTY { $_[0]->{$_[1]->get_name} = $_[2]; } sub INIT_INSTANCE { my $self = shift; $self->{some_enum} = 'value-one'; $self->{some_flags} = ['value-one']; } sub sig1 { shift->signal_emit ('sig1', @_); } package main; my $obj = Tester->new; $obj->sig1 ('value-two', ['value-one', 'value-two']); is ($obj->get ('some_enum'), 'value-one', 'enum property'); $obj->set (some_enum => 'value-two'); is ($obj->get ('some_enum'), 'value-two', 'enum property, after set'); ok (eq_array ([$obj->get ('some_flags')], ['value-one']), 'flags property'); $obj->set (some_flags => ['value-one', 'value-two']); is ($obj->get ('some_flags'), ['value-one', 'value-two'], 'flags property, after set'); __END__ Copyright (C) 2003 by the gtk2-perl team (see the file AUTHORS for the full list) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library 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 Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA.