view release on metacpan or  search on metacpan

t/aion.t  view on Meta::CPAN

# 
# ## Роль наследует роль
# 
# Роль может наследовать другую роль через `with`. Так можно уточнять интерфейс: типы требующихся фичей (`req`) и методов (`:Isa`) либо остаются таÐ...
# 
# Роль `Role::Animal` требует свойство `legs` широкого типа `Num | Object` и метод `sound` с сигнатурой `(Me => Str)`.
# 
::done_testing; }; subtest 'Роль наследует роль' => sub { 
package Role::Animal { use Aion -role;

	req legs => (isa => Num | Object);
	sub sound : Isa(Me => Str);
}

# 
# Роль `Role::Bird` наследует `Role::Animal`, но понижает тип `legs` до `Num`, а сигнатуру метода `sound` оставляет прежней.
# 

package Role::Bird { use Aion -role;

	with qw/Role::Animal/;
	req legs => (isa => Num);
	sub sound : Isa(Me => Str);
}

# 
# Класс `Ex::Sparrow` использует роль `Role::Bird` и реализует все её требования.
# 

package Ex::Sparrow { use Aion;
	with qw/Role::Bird/;

	has legs => (is => 'ro', isa => Num, default => 2);
	sub sound : Isa(Me => Str) { 'chirp' }

local ($::_g0 = do {Num < (Num | Object)}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, '	Num < (Num | Object)  # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
}

my $sparrow = Ex::Sparrow->new;
local ($::_g0 = do {$sparrow->legs}, $::_e0 = "2"); ::ok $::_g0 eq $::_e0, '$sparrow->legs  # => 2' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {$sparrow->sound}, $::_e0 = "chirp"); ::ok $::_g0 eq $::_e0, '$sparrow->sound # => chirp' or ::diag ::_string_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# # ASPECTS
# 
# `use Aion` включает в модуль следующие аспекты для использования в `has`:
# 
# ## is => $permissions
# 
# * `ro` — создать только геттер.
# * `wo` — создать только сеттер.
# * `rw` — создать геттер и сеттер.
# 
# По умолчанию — `rw`.
# 
# Дополнительные разрешения:
# 
# * `+` — фича обязательна в параметрах конструктора. `+` не используется с `-`.
# * `-` — фича не может быть установлена через конструктор. '-' не используется с `+`.
# * `*` — не инкрементировать счётчик ссылок на значение (применить `weaken` к значению после установки его в фичу).
# * `?` – создать предикат.
# * `!` – создать clearer.
# 
::done_testing; }; subtest 'is => $permissions' => sub { 
package ExIs { use Aion;
	has rw => (is => 'rw?!');
	has ro => (is => 'ro+');
	has wo => (is => 'wo-?');
}

eval {ExIs->new}; local ($::_g0 = $@, $::_e0 = 'ro required!'); ok defined($::_g0) && $::_g0 =~ /^${\quotemeta $::_e0}/, 'ExIs->new # @-> ro required!' or ::diag ::_string_diff($::_g0, $::_e0, 1); undef $::_g0; undef $::_e0;
eval {ExIs->new(ro => 10, wo => -10)}; local ($::_g0 = $@, $::_e0 = 'wo excessive!'); ok defined($::_g0) && $::_g0 =~ /^${\quotemeta $::_e0}/, 'ExIs->new(ro => 10, wo => -10) # @-> wo excessive!' or ::diag ::_string_diff($::_g0, $::_e0, 1); undef $::...

local ($::_g0 = do {ExIs->new(ro => 10)->has_rw}, $::_e0 = do {""}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'ExIs->new(ro => 10)->has_rw # -> ""' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
local ($::_g0 = do {ExIs->new(ro => 10, rw => 20)->has_rw}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'ExIs->new(ro => 10, rw => 20)->has_rw # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $:...
local ($::_g0 = do {ExIs->new(ro => 10, rw => 20)->clear_rw->has_rw}, $::_e0 = do {""}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'ExIs->new(ro => 10, rw => 20)->clear_rw->has_rw # -> ""' or ::diag ::_struct_diff($::_g0, $::_e0); ...

local ($::_g0 = do {ExIs->new(ro => 10)->ro}, $::_e0 = do {10}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'ExIs->new(ro => 10)->ro  # -> 10' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

local ($::_g0 = do {ExIs->new(ro => 10)->wo(30)->has_wo}, $::_e0 = do {1}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'ExIs->new(ro => 10)->wo(30)->has_wo # -> 1' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0...
eval {ExIs->new(ro => 10)->wo}; local ($::_g0 = $@, $::_e0 = 'Feature wo cannot be get!'); ok defined($::_g0) && $::_g0 =~ /^${\quotemeta $::_e0}/, 'ExIs->new(ro => 10)->wo # @-> Feature wo cannot be get!' or ::diag ::_string_diff($::_g0, $::_e0, 1);...
local ($::_g0 = do {ExIs->new(ro => 10)->rw(30)->rw}, $::_e0 = do {30}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, 'ExIs->new(ro => 10)->rw(30)->rw  # -> 30' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# Функция с `*` не удерживает значение:
# 

package Node { use Aion;
	has parent => (is => "rw*", isa => Maybe[Object["Node"]]);
}

my $root = Node->new;
my $node = Node->new(parent => $root);

local ($::_g0 = do {$node->parent->parent}, $::_e0 = do {undef}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, '$node->parent->parent   # -> undef' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
undef $root;
local ($::_g0 = do {$node->parent}, $::_e0 = do {undef}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, '$node->parent   # -> undef' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# And by setter:
$node->parent($root = Node->new);

local ($::_g0 = do {$node->parent->parent}, $::_e0 = do {undef}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, '$node->parent->parent   # -> undef' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;
undef $root;
local ($::_g0 = do {$node->parent}, $::_e0 = do {undef}); ::ok defined($::_g0) == defined($::_e0) && $::_g0 eq $::_e0, '$node->parent   # -> undef' or ::diag ::_struct_diff($::_g0, $::_e0); undef $::_g0; undef $::_e0;

# 
# ## isa => $type
# 
# Указывает тип, а точнее – валидатор, фичи.
# 
# Может принимать:
# 
# * `Aion::Type` – Aion сразу импортирует в пакет все типы из [Aion::Types](https://metacpan.org/pod/Aion::Types).
# * Строки воспримаются как пакеты и оборачиваются в `Object`.
# * Подпрограммы – тестируемое значение передаётся в `$_` и подпрограмма возвращает булево значение.
# * Объекты с перегруженным оператором `&{}`. Если у такого объекта есть ещё и метод `coerce`, то он будет учавствовать в приведениях, если указаÑ...
# 
::done_testing; }; subtest 'isa => $type' => sub { 
package Externalis {
	use overload '&{}' => sub { sub { /^\d+$/ } };