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     plan tests => 4;
  10 }
  11
  12 =pod
  13
  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.
  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) {
  37     val color = c;
  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
  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
  87         (blessed($method) && $method->isa('Class::MOP::Method::Accessor'))
  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) {
 104         $metaclass->add_method($method_name => $methods{$method_name})
 105             unless $metaclass->has_method($method_name);
 106     }
 107 }
 108
 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
 162     ::with('ColoredPoint2D');
 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');
 174
 175