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