The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# This is a copy of 03_simple.t but with compile time attribute declaration

use strict;
use warnings;
BEGIN {
	$|  = 1;
	# $POE::Declare::Meta::DEBUG = 1;
}

use Test::More tests => 57;
use Test::NoWarnings;
use Test::Exception;





#####################################################################
# Create the test class

SCOPE: {
	package Foo;

	use POE qw{ Session };
	use POE::Declare {
		bar => 'Internal',
		foo => 'Attribute',
		One => 'Param',
		Two => 'Param',
	};

	# Shut up a warning
	POE::Kernel->run;

	# Check that SELF is exported, and matches HEAP
	main::is( SELF, HEAP, 'SELF == HEAP' );

	sub findme : Event {
		my $self = $_[SELF];
		return $self;
	}

	$Foo::to = 0;
	sub to : Timeout(30) {
		my $self = $_[SELF];
		$Foo::to++;
	}

	1;
}





#####################################################################
# Tests

my $ID1 = ($POE::VERSION >= 1.310) ? 1 : 2;

SCOPE: {
	# There should be no meta-object for the Foo class initially
	is( POE::Declare::meta('Foo'), undef, 'meta(Foo) is undef' );

	# Compile the class
	SCOPE: {
		package Foo;
		Test::More::is(
			POE::Declare::compile,
			1,
			'compile(Foo) returns true',
		);
	}

	# Check the meta-object
	my $meta = POE::Declare::meta('Foo');
	isa_ok( $meta, 'POE::Declare::Meta' );
	is( $meta->compiled, 1, '->compiled is true' );
	is( $meta->name, 'Foo', '->name is ok' );
	my $meta2 = Foo->meta;
	isa_ok( $meta, 'POE::Declare::Meta' );
	is_deeply( $meta, $meta2, 'Foo->meta ok' );
	is( ref($meta->{attr}), 'HASH', '->{attr} is a hash' );
	isa_ok( $meta->{attr}->{foo},    'POE::Declare::Meta::Attribute' );
	isa_ok( $meta->{attr}->{bar},    'POE::Declare::Meta::Internal'  );
	isa_ok( $meta->{attr}->{findme}, 'POE::Declare::Meta::Event'     );
	isa_ok( $meta->{attr}->{to},     'POE::Declare::Meta::Timeout'   );
	is( $meta->{attr}->{foo}->name,    'foo',    'Attribute foo ->name ok'    );
	is( $meta->{attr}->{bar}->name,    'bar',    'Attribute bar ->name ok'    );
        is( $meta->{attr}->{findme}->name, 'findme', 'Attribute findme ->name ok' );
	is( $meta->{attr}->{to}->name,     'to',     'Attribute to ->name ok'     );

	# Create an object
	my $object = Foo->new( One => 'foo' );
	isa_ok( $object, 'Foo' );
	is( $object->One,   'foo',   '->foo created and returns correctly' );
	is( $object->Alias, 'Foo.1', 'Pregenerated ->Alias returns as expected' );

	# Test errors
	throws_ok(
		sub {
			Foo->new( foo => 'bar' );
		},
		qr/Unknown or unsupported Foo param\(s\) foo/,
		'Threw expected constructor error',
	);

	# Check the kernel method
	isa_ok( $object->kernel, 'POE::Kernel' );

	# Check the attr method
	isa_ok( $meta->attr('foo'),    'POE::Declare::Meta::Attribute' );
	isa_ok( $meta->attr('bar'),    'POE::Declare::Meta::Internal'  );
	isa_ok( $meta->attr('findme'), 'POE::Declare::Meta::Event'     );
	isa_ok( $meta->attr('to'),     'POE::Declare::Meta::Timeout'   );
	isa_ok( $meta->attr('One'),    'POE::Declare::Meta::Param'     );
	isa_ok( $meta->attr('Two'),    'POE::Declare::Meta::Param'     );
	is( $meta->attr('foo')->name,    'foo',    'Attribute foo ->name ok'    );
	is( $meta->attr('bar')->name,    'bar',    'Attribute bar ->name ok'    );
	is( $meta->attr('findme')->name, 'findme', 'Attribute findme ->name ok' );
	is( $meta->attr('to')->name,     'to',     'Attribute to ->name ok'     );
	is( $meta->attr('One')->name,    'One',    'Attribute One ->name ok'    );
	is( $meta->attr('Two')->name,    'Two',    'Attribute Two ->name ok'    );

	# Check for the base attributes
	isa_ok( $meta->attr('_start'),        'POE::Declare::Meta::Event' );
	isa_ok( $meta->attr('_stop'),         'POE::Declare::Meta::Event' );

	# Check the package_states method
	is_deeply(
		[ $meta->_package_states ],
		[ '_start', '_stop', 'findme', 'to' ],
		'->_package_states returns as expected',
	);

	# Check the params method
	is_deeply(
		[ $meta->_params ],
		[ 'Alias', 'One', 'Two' ],
		'->_params returns as expected',
	);

	# Check various spawning related methods
	is( $object->spawned, '', '->spawned is false' );
	is( $object->session_id, undef, '->session_id is undef' );
	is( $object->ID, undef, '->ID is undef' );
	is( $object->session, undef, '->session is undef' );
	$object->spawn;
	is( $object->spawned, 1,  '->spawned is true'  );
	is( $object->session_id, $ID1, '->session_id is true' );
	is( $object->ID, $ID1, '->ID is true and matches ->session_id' );
	isa_ok( $object->session, 'POE::Session', '->session is true' );

	# Check the behaviour of SELF in methods
	my $me = $object->call('findme');
	is_deeply( $me, $object, 'SELF works in methods' );
	$object->call('to');
	is( $Foo::to, 1, 'Timeout method called directly increments to' );

	# Check the postback method
	my $postback = $object->postback('findme');
	isa_ok( $postback, 'POE::Session::AnonEvent' );

	# Check the callback method
	my $callback = $object->callback('findme');
	isa_ok( $postback, 'POE::Session::AnonEvent' );

	# Check the lookback method
	my $lookback = $object->lookback('findme');
	is_deeply(
		$lookback,
		[ 'Foo.1', 'findme' ],
		'Created lookback ARRAY',
	);
}





#####################################################################
# Create a subclass

SCOPE: {
	package My::Foo;

	use vars qw{@ISA};
	BEGIN {
		@ISA = 'Foo';
	}

	use POE::Declare {
		baz     => 'Attribute',
		MyParam => 'Param',
	};

	compile;
}





#####################################################################
# Testing the subclass

SCOPE: {
	my $meta = POE::Declare::meta('My::Foo');
	isa_ok( $meta, 'POE::Declare::Meta' );
	is( $meta->name, 'My::Foo', '->name ok' );

	# Check the attr method
	isa_ok( $meta->attr('baz'), 'POE::Declare::Meta::Attribute' );
	isa_ok( $meta->attr('MyParam'), 'POE::Declare::Meta::Param' );
	isa_ok( $meta->attr('foo'), 'POE::Declare::Meta::Attribute' );
}