#!/usr/bin/perl
# vim: set filetype=perl :
#
# $Id$
#

#
# enums and flags.
#

use strict;
use warnings;

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

use Test::More tests => 57;
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");

{
  my $f = Glib::ParamFlags->new (['readable']);
  my $g = $f;
  $g += 'writable';
  ok ($g == ['readable', 'writable'],
      "overloaded +=");
  ok ($f == ['readable'],
      "overloaded += leaves original unchanged");
}

foreach my $method (qw(bool as_arrayref eq union sub intersect xor all)) {
  my $func = Glib::Flags->can($method);
  ok ($func, "Glib::Flags::$method() func found");
  no warnings;
  ok (do { eval { $func->(undef, undef, 0) }; 1 },
      'Glib::Flags::$method() no segfault if passed a non-reference');
}

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

$@ = 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');
is_deeply ($obj->get('some_flags')->as_arrayref, ['value-one'], 'flags property');

is (($obj->get('some_flags') ? "true" : "false"), "true",
    'flags property, boolean context');
is ($obj->get('some_flags')->bool, 1,
    'flags property, bool()');

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

is_deeply (\@{ $obj->get ('some_flags') }, [], 'empty flags @{}');
is_deeply ($obj->get('some_flags')->as_arrayref, [],
           'empty flags, as_arrayref()');

is (($obj->get('some_flags') ? "true" : "false"), "false",
    'empty flags, boolean context');
is ($obj->get('some_flags')->bool, 0,
    'empty flags, bool()');

$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, 2009 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.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.