Server IP : 85.193.89.191 / Your IP : 18.191.22.143 Web Server : Apache System : Linux 956367-cx40159.tmweb.ru 3.10.0-1160.105.1.el7.x86_64 #1 SMP Thu Dec 7 15:39:45 UTC 2023 x86_64 User : bitrix ( 600) PHP Version : 8.1.27 Disable Function : NONE MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : ON Directory : /proc/978/cwd/usr/share/doc/perl-Moose-2.1005/t/basics/ |
Upload File : |
#!/usr/bin/perl use strict; use warnings; use Test::More; use Test::Fatal; { package Foo; use Moose; sub foo { 'Foo::foo(' . (inner() || '') . ')' } sub bar { 'Foo::bar(' . (inner() || '') . ')' } sub baz { 'Foo::baz(' . (inner() || '') . ')' } package Bar; use Moose; extends 'Foo'; augment foo => sub { 'Bar::foo(' . (inner() || '') . ')' }; augment bar => sub { 'Bar::bar' }; no Moose; # ensure inner() still works after unimport package Baz; use Moose; extends 'Bar'; augment foo => sub { 'Baz::foo' }; augment baz => sub { 'Baz::baz' }; # this will actually never run, # because Bar::bar does not call inner() augment bar => sub { 'Baz::bar' }; } my $baz = Baz->new(); isa_ok($baz, 'Baz'); isa_ok($baz, 'Bar'); isa_ok($baz, 'Foo'); is($baz->foo(), 'Foo::foo(Bar::foo(Baz::foo))', '... got the right value from &foo'); is($baz->bar(), 'Foo::bar(Bar::bar)', '... got the right value from &bar'); is($baz->baz(), 'Foo::baz(Baz::baz)', '... got the right value from &baz'); my $bar = Bar->new(); isa_ok($bar, 'Bar'); isa_ok($bar, 'Foo'); is($bar->foo(), 'Foo::foo(Bar::foo())', '... got the right value from &foo'); is($bar->bar(), 'Foo::bar(Bar::bar)', '... got the right value from &bar'); is($bar->baz(), 'Foo::baz()', '... got the right value from &baz'); my $foo = Foo->new(); isa_ok($foo, 'Foo'); is($foo->foo(), 'Foo::foo()', '... got the right value from &foo'); is($foo->bar(), 'Foo::bar()', '... got the right value from &bar'); is($foo->baz(), 'Foo::baz()', '... got the right value from &baz'); # test saved state when crossing objects { package X; use Moose; has name => (is => 'rw'); sub run { "$_[0]->{name}.X", inner() } package Y; use Moose; extends 'X'; augment 'run' => sub { "$_[0]->{name}.Y", ($_[1] ? $_[1]->() : ()), inner(); }; package Z; use Moose; extends 'Y'; augment 'run' => sub { "$_[0]->{name}.Z" } } is('a.X a.Y b.X b.Y b.Z a.Z', do { my $a = Z->new(name => 'a'); my $b = Z->new(name => 'b'); join(' ', $a->run(sub { $b->run })) }, 'State is saved when cross-calling augmented methods on different objects'); # some error cases { package Bling; use Moose; sub bling { 'Bling::bling' } package Bling::Bling; use Moose; extends 'Bling'; sub bling { 'Bling::bling' } ::isnt( ::exception { augment 'bling' => sub {}; }, undef, '... cannot augment a method which has a local equivalent' ); } done_testing;