Server IP : 213.176.29.180 / Your IP : 18.116.28.123 Web Server : Apache System : Linux 213.176.29.180.hostiran.name 4.18.0-553.22.1.el8_10.x86_64 #1 SMP Tue Sep 24 05:16:59 EDT 2024 x86_64 User : webtaragh ( 1001) PHP Version : 7.4.33 Disable Function : NONE MySQL : OFF | cURL : ON | WGET : ON | Perl : ON | Python : ON Directory (0755) : /usr/share/doc/device-mapper/../libmodulemd/../libmetalink/../perl-Sub-Exporter/t/ |
[ Home ] | [ C0mmand ] | [ Upload File ] |
---|
#!/usr/bin/perl -T use strict; use warnings; use Test::More; BEGIN { if (eval { require Package::Generator; 1; }) { plan 'no_plan'; } else { plan skip_all => "the mixin exporter requires Package::Generator"; } } BEGIN { use_ok("Sub::Exporter"); } BEGIN { package Thing; use Sub::Exporter -setup => { exports => { bar => sub { sub { 1 } }, foo => sub { my ($c, $n, $a) = @_; sub { return $c . ($a->{arg}) } } }, }; } BEGIN { package Thing::Mixin; BEGIN { main::use_ok("Sub::Exporter::Util", 'mixin_installer'); } use Sub::Exporter -setup => { installer => mixin_installer, exports => { bar => sub { sub { 1 } }, foo => sub { my ($c, $n, $a) = @_; sub { return $c . ($a->{arg}) } } }, }; } package Test::SubExporter::MIXIN::0; BEGIN { Thing->import( { installer => Sub::Exporter::Util::mixin_installer }, -all => { arg => '0' }, ); } package Test::SubExporter::MIXIN::1; BEGIN { Thing->import( { installer => Sub::Exporter::Util::mixin_installer }, -all => { arg => '1' }, ); } package Test::SubExporter::MIXIN::2; BEGIN { Thing::Mixin->import( -all => { arg => '2' }, ); } package Test::SubExporter::MIXIN::3; BEGIN { Thing::Mixin->import( -all => { arg => '3' }, ); } package main; my @pkg = map { "Test::SubExporter::MIXIN::$_" } (0 .. 3); for (0 .. $#pkg) { my $ext = $_ > 1 ? '::Mixin' : ''; my $val = eval { $pkg[$_]->foo } || ($@ ? "died: $@" : undef); is( $val, "Thing$ext$_", "mixed in method in $pkg[$_] returns correctly" ); is($pkg[$_]->bar, 1, "bar method for $pkg[$_] is ok, too"); } my @super = map {; no strict 'refs'; [ @{$_ . "::ISA"} ] } @pkg; for my $x (0 .. $#pkg) { is(@{$super[$x]}, 1, "one parent for $pkg[$x]: @{$super[$x]}"); for my $y (($x + 1) .. $#pkg) { isnt("@{$super[$x]}", "@{$super[$y]}", "parent($x) ne parent($y)") } } { package Test::SubExporter::OBJECT; sub new { bless {} => shift } sub plugh { "plugh" } } package main; my $obj_1 = Test::SubExporter::OBJECT->new; isa_ok($obj_1, "Test::SubExporter::OBJECT", "first object"); is(ref $obj_1, "Test::SubExporter::OBJECT", "first object's ref is TSEO"); my $obj_2 = Test::SubExporter::OBJECT->new; isa_ok($obj_2, "Test::SubExporter::OBJECT", "second object"); is(ref $obj_2, "Test::SubExporter::OBJECT", "second object's ref is TSEO"); Thing::Mixin->import({ into => $obj_1 }, qw(bar)); pass("mixin-exporting to an object didn't die"); is( eval { $obj_1->bar }, 1, "now that object has a bar method" ); isa_ok($obj_1, "Test::SubExporter::OBJECT"); isnt(ref $obj_1, "Test::SubExporter::OBJECT", "but its actual class isnt TSEO");