#!/usr/bin/perl
# vim: set filetype=perl :
#
# $Header: /cvsroot/gtk2-perl/gtk2-perl-xs/Glib/t/c.t,v 1.12 2008/05/22 22:09:13 kaffeetisch Exp $
#

#
# enums and flags.
#

use strict;
use warnings;

#########################

use Test::More tests => 32;
BEGIN { use_ok('Glib') };

#########################

#
# Flags basics
#

my $f = Glib::ParamFlags->new (['readable', 'writable']); # with array
isa_ok ($f, 'Glib::Flags');
isa_ok ($f, 'Glib::ParamFlags');
ok ($f == ['readable', 'writable'], "value");

$f = Glib::ParamFlags->new ('readable'); # with plain string
isa_ok ($f, 'Glib::Flags');
isa_ok ($f, 'Glib::ParamFlags');
ok ($f == ['readable'], "value");

my $g = Glib::ParamFlags->new ($f + 'writable'); # from another
isa_ok ($g, 'Glib::ParamFlags');
ok ($g >= $f);

$@ = undef;
eval { my $h = Glib::Flags->new (['readable']); };
ok ($@, "Will croak on trying to create plain old Glib::Flags");

#########################

$@ = 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');
is_deeply ([Glib::Type->list_ancestors ('TestEnum')],
	   ['TestEnum', 'Glib::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');
is_deeply ([Glib::Type->list_ancestors ('TestFlags')],
	   ['TestFlags', 'Glib::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');

my @actual_values = Glib::Type->list_values ('TestEnum');
my @expected_values = (
  {
    value => 1,
    name => 'value-one',
    nick => 'value-one',
  },
  {
    value => 2,
    name => 'value-two',
    nick => 'value-two',
  },
  {
    value => 3,
    name => 'value-three',
    nick => 'value-three',
  },
  {
    value => 42,
    name => 'value-four',
    nick => 'value-four',
  },
  {
    value => 5,
    name => 'value-five',
    nick => 'value-five',
  },
  {
    value => 6,
    name => 'value-six',
    nick => 'value-six',
  },
);
is_deeply (\@actual_values, \@expected_values, 'list_interfaces');

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;

#
# App-registered flags.
#

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');

is_deeply (\@{ $obj->get ('some_flags') }, ['value-one'], 'flags property');
$obj->set (some_flags => ['value-one', 'value-two']);
is_deeply (\@{ $obj->get ('some_flags') }, ['value-one', 'value-two'],
	   'flags property, after set');

ok ($obj->get ('some_flags') & $obj->get ('some_flags'),
    '& is overloaded');

eval {
  $obj->set (some_flags => []);
  $obj->set (some_flags => undef);
};
ok ($@ eq '', 'empty flags values do not croak');
ok ($obj->get ('some_flags') == [], 'empty flags values work');

$obj->set (some_flags => [qw/value-one value-two/]);

ok ($obj->get ('some_flags') == [qw/value-one value-two/], '== is overloaded');
ok ($obj->get ('some_flags') != [qw/value-one/], '!= is overloaded');

ok ($obj->get ('some_flags') eq [qw/value-one value-two/], 'eq is overloaded');
ok ($obj->get ('some_flags') ne [qw/value-one/], 'ne is overloaded');

__END__

Copyright (C) 2003-2005 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.