Permalink
Fetching contributors…
Cannot retrieve contributors at this time
170 lines (137 sloc) 4.28 KB
use v6;
use lib $?FILE.IO.parent(2).add("packages");
use Test;
use Test::Util;
=begin pod
Class Attributes
=end pod
#L<S12/Class attributes/"Class attributes are declared">
#L<S12/Class methods/Such a metaclass method is always delegated>
plan 24;
class Foo {
our $.bar = 23;
our $.yada = 13;
}
my $test = 0;
ok ($test = Foo.bar), 'accessors for class attributes work';
is $test, 23, 'class attributes really work';
class Baz is Foo {};
my $test2 = 0;
lives-ok { $test2 = Baz.bar }, 'inherited class attribute accessors work';
is $test2, 23, 'inherited class attributes really work';
my $test3 = 0;
lives-ok { Baz.yada = 42; $test3 = Baz.yada }, 'inherited rw class attribute accessors work';
is $test3, 42, 'inherited rw class attributes really work';
class Quux is Foo { has $.bar = 17; };
my $test4 = 0;
lives-ok { $test4 = Quux.new() },
'Can instantiate with overridden instance method';
is $test4.bar, 17, 'Instance call gets instance attribute, not class attribute';
my $test5 = 0;
dies-ok {$test5 = Quux.bar}, 'class attribute accessor hidden by accessor in subclass; we do not magically ignore it';
{
class Oof {
my $.x;
}
my $x = Oof.new();
$x.x = 42;
is($x.x, 42, "class attribute accessors work");
my $y = Oof.new();
is($y.x, 42, "class attributes shared by all instances");
}
# RT #122087
{
class Woof {
my $.x = 'yap';
}
my $x = Woof.new();
is($x.x, 'yap', "class attribute initialization works");
}
# RT #57336
{
# TODO: Test that the exceptions thrown here are the right ones
# and not the result of some other bug.
my $bad_code;
$bad_code = '$.a';
try EVAL $bad_code;
ok $! ~~ Exception, "bad code: '$bad_code'";
$bad_code ='$!a';
try EVAL $bad_code;
ok $! ~~ Exception, "bad code: '$bad_code'";
$bad_code = 'class B0rk { has $.a; say $.a; }';
try EVAL $bad_code;
ok $! ~~ Exception, "bad code: '$bad_code'";
$bad_code = 'class Chef { my $.a; say $.a; }';
try EVAL $bad_code;
ok $! ~~ Exception, "bad code: '$bad_code'";
}
# RT #114230
{
class RT114230 {
has &!x;
method f {
&!x //= { 'ook!' };
my $res = defined &!x;
&!x();
}
}
lives-ok { RT114230.new.f },
'no Null PMC access when doing //= on an undefined attribute and then calling it';
}
{
class A {
has $.b = 1;
method b() { 2; }
};
is A.new.b, 2, "don't create accessor if the class declares an explicit method of that name";
role B {
has $.b = 1;
method b() { 2; }
};
is B.new.b, 2;
}
# RT #102478
{
class RT102478_1 { BEGIN EVAL q[has $.x] };
is RT102478_1.new(x => 3).x, 3,
'can declare attribute inside of a BEGIN EVAL in class';
class RT102478_2 { EVAL q[has $.x] };
throws-like { RT102478_2.new(x => 3).x },
X::Method::NotFound,
'cannot declare attribute inside of an EVAL in class';
}
# RT #125625
is_run(
'our $.a',
{ err => -> $o { $o ~~ /:i useless/ && $o ~~ /:i accessor/ } },
'useless our $.a accessor method generation error contains useful enough hints'
);
is_run(
'my $.a',
{ err => -> $o { $o ~~ /:i useless/ && $o ~~ /:i accessor/ } },
'useless my $.a accessor method generation error contains useful enough hints'
);
# RT #130748
subtest 'attribute access from where clauses' => {
plan 7;
throws-like my class RT130748a { has $.a; has $.b where $!a },
X::Syntax::NoSelf, 'where, thunk, attr only';
throws-like my class RT130748b { has $.a; has $.b where * > $!a },
X::Syntax::NoSelf, 'where, whatevercode';
throws-like my class RT130748c { has $.a; has $.b where {$!a},
X::Syntax::NoSelf, 'where, block';
my class RT130748d {
has $.a = 42;
has $.b where *.so = $!a+1;
method z-thunk ($x where $!a ) { pass 'where in method param, thunk' }
method z-block ($x where {$!a}) { pass 'where in method param, block' }
method z-whatever ($x where *+$!a) {
pass 'where in method param, whatevercode'
}
}
is-deeply RT130748d.new.b, 43, 'can still use attr in default values';
RT130748d.new.z-thunk: 42;
RT130748d.new.z-block: 42;
RT130748d.new.z-whatever: 42;
}
# vim: ft=perl6