t/050_scala_style_mixin_composition.t

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