Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
133 lines (106 sloc) 4.04 KB
use v6;
use Test;
plan 29;
=begin pod
Basic submethod tests. See L<S12/"Submethods">
=end pod
# L<S12/Submethods>
{
class Foo { has $.foo_build; submethod BUILD() { $!foo_build++ } }
class Bar is Foo { has $.bar_build; submethod BUILD() { $!bar_build++ } }
my $a;
lives-ok {$a = Foo.new()}, "Foo.new() worked (1)";
is $a.foo_build, 1, "Foo's BUILD was called";
# is instead of todo_is to avoid unexpected succeedings
dies-ok { $a.bar_build }, "Bar's BUILD counter not available";
my $b;
lives-ok {$b = Bar.new()}, "Bar.new() worked";
is $b.foo_build, 1, "Foo's BUILD was called again";
is $b.bar_build, 1, "Bar's BUILD was called, too";
# The next three tests are basically exactly the same as the first three tests
# (not counting the initial class definition). This is to verify our call to
# Bar.new didn't removed/changed some internal structures which'd prevent
# Foo.BUILD of getting called.
my $c;
lives-ok {$c = Foo.new()}, "Foo.new() worked (2)";
is $c.foo_build, 1, "Foo's BUILD was called again";
}
# See thread "BUILD and other submethods" on p6l
# L<"http://groups-beta.google.com/group/perl.perl6.language/msg/e9174e5538ded4a3">
{
class Baz {
has $.baz_blarb = 0;
submethod blarb() { $!baz_blarb++ }
}
class Grtz is Baz {
has $.grtz_blarb = 0;
submethod blarb() { $!grtz_blarb++ }
}
my ($baz, $grtz);
lives-ok {$baz = Baz.new}, "Baz.new() worked";
lives-ok {$grtz = Grtz.new}, "Grtz.new() worked";
lives-ok { $baz.blarb }, 'can call submethod on parent class';
is $baz.baz_blarb, 1, "Baz's submethod blarb was called";
is $grtz.grtz_blarb, 0, "Grtz's submethod blarb was not called";
lives-ok { $grtz.blarb }, 'can call submethod on child class';
is $grtz.baz_blarb, 0, "Baz's submethod blarb was not called";
is $grtz.grtz_blarb, 1, "Grtz's submethod blarb was called now";
lives-ok { $grtz.Baz::blarb }, '$obj.Class::submthod';
is $grtz.baz_blarb, 1, "Baz's submethod blarb was called now";
is $grtz.grtz_blarb, 1, "Grtz's submethod blarb was not called again";
}
# Roles with BUILD
# See thread "Roles and BUILD" on p6l
# L<"http://www.nntp.perl.org/group/perl.perl6.language/21277">
#?rakudo skip 'outer lexicals in roles RT #124850'
#?niecza todo
{
my $was_in_a1_build = 0;
my $was_in_a2_build = 0;
role RoleA1 { multi submethod BUILD() { $was_in_a1_build++ } }
role RoleA2 { multi submethod BUILD() { $was_in_a2_build++ } }
class ClassA does RoleA1 does RoleA2 {}
ClassA.new;
is $was_in_a1_build, 1, "roles' BUILD submethods were called when mixed in a class (1)";
is $was_in_a2_build, 1, "roles' BUILD submethods were called when mixed in a class (2)";
}
#?rakudo skip 'roles and submethods RT #124851'
#?DOES 4
{
my $was_in_b1_build = 0;
my $was_in_b2_build = 0;
role RoleB1 { multi submethod BUILD() { $was_in_b1_build++ } }
role RoleB2 { multi submethod BUILD() { $was_in_b2_build++ } }
class ClassB {}
my $B = ClassB.new;
is $was_in_b1_build, 0, "roles' BUILD submethods were not yet called (1)";
is $was_in_b2_build, 0, "roles' BUILD submethods were not yet called (2)";
$B does (RoleB1, RoleB2);
#?niecza 2 todo
is $was_in_b1_build, 1, "roles' BUILD submethods were called now (1)";
is $was_in_b2_build, 1, "roles' BUILD submethods were called now (2)";
};
# BUILD with signatures that don't map directly to attributes
{
class ClassC
{
has $.double_value;
submethod BUILD ( :$value = 1 )
{
$!double_value = $value * 2;
}
}
my $C = ClassC.new();
is( $C.double_value, 2,
'BUILD() should allow default values of optional params in signature' );
my $C2 = ClassC.new( :value(100) );
is( $C2.double_value, 200, '... or value passed in' );
}
# RT #127660
{
my class M { method Bool { True } }
is M || 42, M, 'Bool method in class is used in boolificiation';
my class SM { submethod Bool { True } }
is SM || 42, SM, 'Bool submethod in class is used in boolificiation';
}
# vim: ft=perl6
Something went wrong with that request. Please try again.