forked from Raku/roast
-
Notifications
You must be signed in to change notification settings - Fork 0
/
mutators.t
105 lines (83 loc) · 2.78 KB
/
mutators.t
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
use v6;
# this tests that you can define mutators, that do more interesting
# things than merely assigning the value!
use Test;
plan 25;
class LValueMutator {
has Int $.foo;
has Int $!bar;
method foo returns Int is rw {
return $!bar;
}
method get_foo returns Int is rw {
return $.foo;
}
}
my $lvm = LValueMutator.new(:foo(3));
#?pugs todo 'oo'
# XXX is this correct? .new calls BUILD, which in turn calls bless,
# which in turns initializes the attributes directly
#?rakudo todo 'OO (test needs review)'
is($lvm.foo, 3, "constructor uses lvalue accessor method");
nok($lvm.get_foo.defined, "constructor doesn't simply set attributes");
lives_ok { $lvm.get_foo = 6 }, "lvalue accessors seem to work";
is($lvm.get_foo, 6, "lvalue accessors work");
lives_ok { $lvm.foo = 5 }, "lvalue accessors work still";
is($lvm.foo, 5, "mutator seems to work");
our Int $count = 0;
class MagicVal {
has Int $.constant;
has Int $.varies is rw;
method varies returns Int is rw {
$count++;
my $var is Proxy( :for($.varies),
:FETCH{ $.varies += 2 },
:STORE{ $.varies = $_ + 1 },
);
return $var;
}
}
my $mv = MagicVal.new(:constant(6), :varies(6));
is($mv.constant, 6, "normal attribute");
is($mv.constant, 6, "normal attribute");
dies_ok { $mv.constant = 7 }, "can't change a non-rw attribute";
is($mv.constant, 6, "attribute didn't change value");
#?rakudo todo 'overring mutators'
is($count, 2, "mutator was called");
#?rakudo skip 'oo: mutators'
{
is($mv.varies, 9, "mutator called during object construction");
is($count, 3, "accessor was called");
is($mv.varies, 11, "attribute with mutating accessor");
is($count, 4, "accessor was called");
$count = 0;
$mv.varies = 13;
is($count, 2, "mutator was called");
is($mv.varies, 16, "attribute with overridden mutator");
is($count, 3, "accessor and mutator were called");
}
# test interface tentatively not entirely disapproved of by
# all(@Larry) at L<"http://xrl.us/gnxp">
class MagicSub {
has Int $.constant;
has Int $.varies is rw;
method varies returns Int is rw {
return Proxy.new(
:FETCH{ $.varies += 2 },
:STORE{ $.varies = $^v + 1 }
);
}
}
#?rakudo skip 'class Proxy'
{
my $mv = MagicVal.new(:constant(6), :varies(6));
is($mv.constant, 6, "normal attribute");
is($mv.constant, 6, "normal attribute");
dies_ok { $mv.constant = 7 }, "can't change a non-rw attribute";
is($mv.constant, 6, "attribute didn't change value");
is($mv.varies, 9, "mutator called during object construction");
is($mv.varies, 11, "attribute with mutating accessor");
$mv.varies = 13;
is($mv.varies, 16, "attribute with overridden mutator");
}
# vim: ft=perl6