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