view release on metacpan or  search on metacpan

t/aion.t  view on Meta::CPAN

# 
# Aion - постмодернистская объектная система для Perl 5, такая как «Mouse», «Moose», «Moo», «Mo» и «M», но с улучшениями
# 
# # VERSION
# 
# 2.2
# 
# # SYNOPSIS
# 
subtest 'SYNOPSIS' => sub { 
package Calc {

	use Aion;

	has a => (is => 'ro+', isa => Num);
	has b => (is => 'ro+', isa => Num);
	has op => (is => 'ro', isa => Enum[qw/+ - * \/ **/], default => '+');

	sub result : Isa(Me => Num) {
		my ($self) = @_;
		eval "${\ $self->a} ${\ $self->op} ${\ $self->b}";
	}

}

local ($::_g0 = do {Calc->new(a => 1.1, b => 2)->result}, $::_e0 = "3.1"); ::ok $::_g0 eq $::_e0, 'Calc->new(a => 1.1, b => 2)->result   # => 3.1' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# # DESCRIPTION
# 
# Aion — ООП-фреймворк для создания классов с **фичами**, имеет **аспекты**, **роли** и так далее.
# 
# Свойства, объявленные через has, называются **фичами**.
# 
# А `is`, `isa`, `default` и так далее в `has` называются **аспектами**.
# 
# Помимо стандартных аспектов, роли могут добавлять свои собственные аспекты с помощью подпрограммы **aspect**.
# 
# Сигнатура методов может проверяться с помощью атрибута `:Isa(...)`.
# 
# # SUBROUTINES IN CLASSES AND ROLES
# 
# `use Aion` импортирует типы из модуля `Aion::Types` и следующие подпрограммы:
# 
# ## has ($name, %aspects)
# 
# Создаёт метод для получения/установки функции (свойства) класса.
# 
# Файл lib/Animal.pm:
#@> lib/Animal.pm
#>> package Animal;
#>> use Aion;
#>> 
#>> has type => (is => 'ro+', isa => Str);
#>> has name => (is => 'rw-', isa => Str, default => 'murka');
#>> 
#>> 1;
#@< EOF
# 
::done_testing; }; subtest 'has ($name, %aspects)' => sub { 
use lib "lib";
use Animal;

my $cat = Animal->new(type => 'cat');

local ($::_g0 = do {$cat->type}, $::_e0 = "cat"); ::ok $::_g0 eq $::_e0, '$cat->type   # => cat' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {$cat->name}, $::_e0 = "murka"); ::ok $::_g0 eq $::_e0, '$cat->name   # => murka' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

$cat->name("murzik");
local ($::_g0 = do {$cat->name}, $::_e0 = "murzik"); ::ok $::_g0 eq $::_e0, '$cat->name   # => murzik' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## with
# 
# Добавляет в модуль роли. Для каждой роли вызывается метод `import_with`.
# 
# Файл lib/Role/Keys/Stringify.pm:
#@> lib/Role/Keys/Stringify.pm
#>> package Role::Keys::Stringify;
#>> 
#>> use Aion -role;
#>> 
#>> sub keysify {
#>> 	my ($self) = @_;
#>> 	join ", ", sort keys %$self;
#>> }
#>> 
#>> 1;
#@< EOF
# 
# Файл lib/Role/Values/Stringify.pm:
#@> lib/Role/Values/Stringify.pm
#>> package Role::Values::Stringify;
#>> 
#>> use Aion -role;
#>> 
#>> sub valsify {
#>> 	my ($self) = @_;
#>> 	join ", ", map $self->{$_}, sort keys %$self;
#>> }
#>> 
#>> 1;
#@< EOF
# 
# Файл lib/Class/All/Stringify.pm:
#@> lib/Class/All/Stringify.pm
#>> package Class::All::Stringify;
#>> 
#>> use Aion;
#>> 
#>> with q/Role::Keys::Stringify/;
#>> with q/Role::Values::Stringify/;
#>> 
#>> has [qw/key1 key2/] => (is => 'rw', isa => Str);
#>> 
#>> 1;
#@< EOF
# 
::done_testing; }; subtest 'with' => sub { 
use lib "lib";
use Class::All::Stringify;

my $s = Class::All::Stringify->new(key1=>"a", key2=>"b");

local ($::_g0 = do {$s->keysify}, $::_e0 = "key1, key2"); ::ok $::_g0 eq $::_e0, '$s->keysify	 # => key1, key2' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {$s->valsify}, $::_e0 = "a, b"); ::ok $::_g0 eq $::_e0, '$s->valsify	 # => a, b' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## exactly ($package)
# 
# Проверяет, что `$package` — это суперкласс для данного или сам этот класс.
# 
# Реализацию метода `isa` Aion не меняет и она находит как суперклассы, так и роли (так как и те и другие добавляются в `@ISA` пакета).
# 
::done_testing; }; subtest 'exactly ($package)' => sub { 
package Ex::X { use Aion; }
package Ex::A { use Aion; extends q/Ex::X/; }
package Ex::B { use Aion; }
package Ex::C { use Aion; extends qw/Ex::A Ex::B/ }

local ($::_g0 = do {Ex::C->exactly("Ex::A")}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::C->exactly("Ex::A") # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Ex::C->exactly("Ex::B")}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::C->exactly("Ex::B") # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Ex::C->exactly("Ex::X")}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::C->exactly("Ex::X") # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Ex::C->exactly("Ex::X1")}, $::_e0 = do {""}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::C->exactly("Ex::X1") # -> ""' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Ex::A->exactly("Ex::X")}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::A->exactly("Ex::X") # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Ex::A->exactly("Ex::A")}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::A->exactly("Ex::A") # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Ex::X->exactly("Ex::X")}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::X->exactly("Ex::X") # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## does ($package)
# 
# Проверяет, что `$package` — это роль, которая используется в классе или другой роли.
# 
::done_testing; }; subtest 'does ($package)' => sub { 
package Role::X { use Aion -role; }
package Role::A { use Aion -role; with qw/Role::X/; }
package Role::B { use Aion -role; }
package Ex::Z { use Aion; with qw/Role::A Role::B/; }

local ($::_g0 = do {Ex::Z->does("Role::A")}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::Z->does("Role::A") # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Ex::Z->does("Role::B")}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::Z->does("Role::B") # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Ex::Z->does("Role::X")}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::Z->does("Role::X") # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Role::A->does("Role::X")}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Role::A->does("Role::X") # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Role::A->does("Role::X1")}, $::_e0 = do {""}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Role::A->does("Role::X1") # -> ""' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {Ex::Z->does("Ex::Z")}, $::_e0 = do {""}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'Ex::Z->does("Ex::Z") # -> ""' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## aspect ($aspect => sub { ... })
# 
# Добавляет аспект к `has` в текущем классе и его классам-наследникам или текущей роли и применяющим её классам.
# 
::done_testing; }; subtest 'aspect ($aspect => sub { ... })' => sub { 
package Example::Earth {
	use Aion;

	aspect lvalue => sub {
		my ($lvalue, $feature) = @_;

		return unless $lvalue;