Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
109 lines (83 sloc) 2.85 KB
use v6;
use Test;
=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 23;
class Foo {
our $.bar = 23;
our $.yada is rw = 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;
#?pugs 99 todo 'class attributes'
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';
# L<S12/Class methods/"you can associate a method with the current
# metaclass instance">
#?niecza skip 'method ^foo'
#?rakudo skip 'nom regression - method ^foo'
{
class T1 {
our $c = 0;
method ^count($obj) { #OK not used
return $c;
}
method mi { ++$c };
method md { --$c };
}
my ($a, $b, $c) = map { T1.new() }, 1..3;
is $c.mi, 1, 'can increment class variable in instance method';
is $b.mi, 2, '.. and the class variable is really shared';
is $a.count, 2, 'can call the class method on an object';
is T1.count, 2, '... and on the proto object';
is T1.^count, 2, '... and on the proto object with Class.^method';
is $a.^count, 2, '... and $obj.^method';
is T1.HOW.count(T1), 2, '... and by explicitly using .HOW with proto object';
is $a.HOW.count($a), 2, '... and by explicitly using .HOW with instance';
}
{
class Oof {
my $.x is rw;
}
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 #57336
#?niecza skip 'Exception'
{
# 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'";
}
# vim: ft=perl6
Jump to Line
Something went wrong with that request. Please try again.