t/050_scala_style_mixin_composition.t

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