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