Commit | Line | Data |
663f8198 |
1 | use strict; |
2 | use warnings; |
3 | |
ea263060 |
4 | use Test::More; |
5 | |
0f352882 |
6 | use Test::Requires { |
7 | 'SUPER' => 1.10, # skip all if not installed |
8 | }; |
663f8198 |
9 | |
10 | =pod |
11 | |
86a4d873 |
12 | This test demonstrates how simple it is to create Scala Style |
13 | Class Mixin Composition. Below is an example taken from the |
ea263060 |
14 | Scala web site's example section, and trancoded to Class::MOP. |
15 | |
16 | NOTE: |
17 | We require SUPER for this test to handle the issue with SUPER:: |
86a4d873 |
18 | being determined at compile time. |
663f8198 |
19 | |
20 | L<http://scala.epfl.ch/intro/mixin.html> |
21 | |
86a4d873 |
22 | A class can only be used as a mixin in the definition of another |
23 | class, if this other class extends a subclass of the superclass |
24 | of the mixin. Since ColoredPoint3D extends Point3D and Point3D |
25 | extends Point2D which is the superclass of ColoredPoint2D, the |
663f8198 |
26 | code above is well-formed. |
27 | |
28 | class Point2D(xc: Int, yc: Int) { |
29 | val x = xc; |
30 | val y = yc; |
31 | override def toString() = "x = " + x + ", y = " + y; |
32 | } |
86a4d873 |
33 | |
663f8198 |
34 | class ColoredPoint2D(u: Int, v: Int, c: String) extends Point2D(u, v) { |
aa448b16 |
35 | val color = c; |
663f8198 |
36 | def setColor(newCol: String): Unit = color = newCol; |
37 | override def toString() = super.toString() + ", col = " + color; |
38 | } |
86a4d873 |
39 | |
663f8198 |
40 | class Point3D(xc: Int, yc: Int, zc: Int) extends Point2D(xc, yc) { |
41 | val z = zc; |
42 | override def toString() = super.toString() + ", z = " + z; |
43 | } |
86a4d873 |
44 | |
663f8198 |
45 | class ColoredPoint3D(xc: Int, yc: Int, zc: Int, col: String) |
46 | extends Point3D(xc, yc, zc) |
47 | with ColoredPoint2D(xc, yc, col); |
86a4d873 |
48 | |
49 | |
663f8198 |
50 | Console.println(new ColoredPoint3D(1, 2, 3, "blue").toString()) |
86a4d873 |
51 | |
663f8198 |
52 | "x = 1, y = 2, z = 3, col = blue" |
86a4d873 |
53 | |
663f8198 |
54 | =cut |
55 | |
ea263060 |
56 | use Scalar::Util 'blessed'; |
57 | use Carp 'confess'; |
58 | |
59 | sub ::with ($) { |
86a4d873 |
60 | # fetch the metaclass for the |
ea263060 |
61 | # caller and the mixin arg |
62 | my $metaclass = (caller)->meta; |
63 | my $mixin = (shift)->meta; |
86a4d873 |
64 | |
65 | # according to Scala, the |
ea263060 |
66 | # the superclass of our class |
86a4d873 |
67 | # must be a subclass of the |
ea263060 |
68 | # superclass of the mixin (see above) |
69 | my ($super_meta) = $metaclass->superclasses(); |
86a4d873 |
70 | my ($super_mixin) = $mixin->superclasses(); |
ea263060 |
71 | ($super_meta->isa($super_mixin)) |
72 | || confess "The superclass must extend a subclass of the superclass of the mixin"; |
86a4d873 |
73 | |
ea263060 |
74 | # collect all the attributes |
86a4d873 |
75 | # and clone them so they can |
ea263060 |
76 | # associate with the new class |
86a4d873 |
77 | my @attributes = map { |
78 | $mixin->get_attribute($_)->clone() |
79 | } $mixin->get_attribute_list; |
80 | |
81 | my %methods = map { |
ea263060 |
82 | my $method = $mixin->get_method($_); |
83 | # we want to ignore accessors since |
84 | # they will be created with the attrs |
ba38bf08 |
85 | (blessed($method) && $method->isa('Class::MOP::Method::Accessor')) |
ea263060 |
86 | ? () : ($_ => $method) |
86a4d873 |
87 | } $mixin->get_method_list; |
ea263060 |
88 | |
89 | # NOTE: |
86a4d873 |
90 | # I assume that locally defined methods |
ea263060 |
91 | # and attributes get precedence over those |
92 | # from the mixin. |
93 | |
94 | # add all the attributes in .... |
95 | foreach my $attr (@attributes) { |
86a4d873 |
96 | $metaclass->add_attribute($attr) |
ea263060 |
97 | unless $metaclass->has_attribute($attr->name); |
98 | } |
99 | |
86a4d873 |
100 | # add all the methods in .... |
ea263060 |
101 | foreach my $method_name (keys %methods) { |
86a4d873 |
102 | $metaclass->add_method($method_name => $methods{$method_name}) |
ea263060 |
103 | unless $metaclass->has_method($method_name); |
86a4d873 |
104 | } |
ea263060 |
105 | } |
106 | |
663f8198 |
107 | { |
108 | package Point2D; |
109 | use metaclass; |
86a4d873 |
110 | |
663f8198 |
111 | Point2D->meta->add_attribute('$x' => ( |
112 | accessor => 'x', |
113 | init_arg => 'x', |
114 | )); |
86a4d873 |
115 | |
663f8198 |
116 | Point2D->meta->add_attribute('$y' => ( |
117 | accessor => 'y', |
118 | init_arg => 'y', |
86a4d873 |
119 | )); |
120 | |
663f8198 |
121 | sub new { |
122 | my $class = shift; |
123 | $class->meta->new_object(@_); |
86a4d873 |
124 | } |
125 | |
663f8198 |
126 | sub toString { |
127 | my $self = shift; |
128 | "x = " . $self->x . ", y = " . $self->y; |
129 | } |
86a4d873 |
130 | |
663f8198 |
131 | package ColoredPoint2D; |
132 | our @ISA = ('Point2D'); |
86a4d873 |
133 | |
663f8198 |
134 | ColoredPoint2D->meta->add_attribute('$color' => ( |
135 | accessor => 'color', |
136 | init_arg => 'color', |
86a4d873 |
137 | )); |
138 | |
663f8198 |
139 | sub toString { |
140 | my $self = shift; |
141 | $self->SUPER() . ', col = ' . $self->color; |
142 | } |
86a4d873 |
143 | |
663f8198 |
144 | package Point3D; |
145 | our @ISA = ('Point2D'); |
86a4d873 |
146 | |
663f8198 |
147 | Point3D->meta->add_attribute('$z' => ( |
148 | accessor => 'z', |
149 | init_arg => 'z', |
86a4d873 |
150 | )); |
663f8198 |
151 | |
152 | sub toString { |
153 | my $self = shift; |
154 | $self->SUPER() . ', z = ' . $self->z; |
155 | } |
86a4d873 |
156 | |
663f8198 |
157 | package ColoredPoint3D; |
86a4d873 |
158 | our @ISA = ('Point3D'); |
159 | |
ea263060 |
160 | ::with('ColoredPoint2D'); |
86a4d873 |
161 | |
663f8198 |
162 | } |
163 | |
164 | my $colored_point_3d = ColoredPoint3D->new(x => 1, y => 2, z => 3, color => 'blue'); |
165 | isa_ok($colored_point_3d, 'ColoredPoint3D'); |
166 | isa_ok($colored_point_3d, 'Point3D'); |
167 | isa_ok($colored_point_3d, 'Point2D'); |
168 | |
169 | is($colored_point_3d->toString(), |
170 | 'x = 1, y = 2, z = 3, col = blue', |
171 | '... got the right toString method'); |
aa448b16 |
172 | |
86a4d873 |
173 | done_testing; |