-
Notifications
You must be signed in to change notification settings - Fork 138
/
metamodel.t
executable file
·140 lines (114 loc) · 3.08 KB
/
metamodel.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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
#!./parrot
# Copyright (C) 2007-2010, Parrot Foundation.
=head1 NAME
t/oo/metamodel.t - test the metamodel for Parrot OO
=head1 SYNOPSIS
% prove t/oo/metamodel.t
=head1 DESCRIPTION
Tests the metamodel for the OO implementation.
=cut
.sub _main :main
.include 'test_more.pir'
plan( 12 )
.local pmc class, init_args1
init_args1 = new 'Hash'
init_args1['name'] = 'Dog'
class = new "Class", init_args1
isa_ok(class, "Class", "created class isa Class")
$P1 = class.'name'()
is($P1, "Dog", "created a new class via Class")
$P1 = class.'name'()
is($P1, "Dog", "Class accessor doesn't destroy value")
class.'add_attribute'('bark')
class.'add_attribute'('ear')
class.'add_attribute'('tail')
.local pmc attributes
attributes = class.'attributes'()
$I0 = exists attributes['bark']
ok($I0, "added attribute to the class")
$I0 = exists attributes['tail']
ok($I0, "added second attribute to the class")
unless $I0 goto no_tail_attribute
$P1 = attributes['tail']
$S1 = $P1['type']
$I0 = iseq $S1, 'Str'
todo($I0, "tail attribute has a type", "not implemented: GH #410")
# is($S1,'Str', "tail attribute has a type")
goto end_tail_attrib_test
no_tail_attribute:
fail("tail attribute doesn't exist")
end_tail_attrib_test:
$P0 = get_class 'Dog'
$I0 = issame $P0, class
ok($I0, "get_class can find the class")
$P0 = class.'new'( 'bark' => "Wooof", 'tail' => 'long' )
$P1 = getattribute $P0, "tail"
$I0 = defined $P1
ok($I0, "got back a tail attribute object")
unless $I0 goto FAILTAIL
is($P1, "long", "tail attribute has expected value")
goto NEXTTAIL
FAILTAIL:
fail("no attribute")
NEXTTAIL:
$P1 = getattribute $P0, "bark"
$I0 = defined $P1
ok($I0, "got back a bark attribute object")
unless $I0 goto FAIL
is($P1, "Wooof", "bark attribute has expected value")
goto NEXT
FAIL:
fail("no attribute")
NEXT:
$P0 = new "Dog"
$I0 = defined $P0
isa_ok($P0, "Dog", "new opcode makes working objects")
.end
.sub fail
.param string desc
'ok'(0, desc)
.end
.namespace['Dog']
.sub _accessor :method
.param string attrib
.param pmc value :optional
.param int got_value
unless got_value goto get_attr
setattribute self, attrib, value
get_attr:
.local pmc rv
rv = getattribute self, attrib
.return(rv)
.end
.sub init_pmc :vtable :method
.param pmc init_args
# Iterate over the constructor arguments, calling the accessor for each
.local pmc it
it = iter init_args
iter_loop:
unless it goto iter_end
$S1 = shift it
$P1 = it[$S1]
self.$S1($P1)
goto iter_loop
iter_end:
.end
.sub bark :method
.param pmc bark :optional
.param int got_bark :opt_flag
.local pmc rv
rv = self.'_accessor'( "bark", bark, got_bark )
.return(rv)
.end
.sub tail :method
.param pmc tail :optional
.param int got_tail :opt_flag
.local pmc rv
rv = self.'_accessor'( "tail", tail, got_tail )
.return(rv)
.end
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir: