#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 13;
use Test::Exception;

use Perl6::MetaModel;

=pod

"My first example"
class O: pass
class F(O): pass
class E(O): pass
class D(O): pass
class C(D,F): pass
class B(D,E): pass
class A(B,C): pass

                          6
                         ---
Level 3                 | O |                  (more general)
                      /  ---  \
                     /    |    \                      |
                    /     |     \                     |
                   /      |      \                    |
                  ---    ---    ---                   |
Level 2        3 | D | 4| E |  | F | 5                |
                  ---    ---    ---                   |
                   \  \ _ /       |                   |
                    \    / \ _    |                   |
                     \  /      \  |                   |
                      ---      ---                    |
Level 1            1 | B |    | C | 2                 |
                      ---      ---                    |
                        \      /                      |
                         \    /                      \ /
                           ---
Level 0                 0 | A |                (more specialized)
                           ---

=cut

my $F = class 'F' => { is => [ $::Object ] };
my $E = class 'E' => { is => [ $::Object ] };
my $D = class 'D' => { is => [ $::Object ] };
my $C = class 'C' => { is => [ $D, $F ] };
my $B = class 'B' => { is => [ $D, $E ] };
my $A = class 'A' => { is => [ $B, $C ] };

is_deeply(
    [ $F->MRO ],
    [ $F, $::Object ],
    '... got the right MRO for F');

is_deeply(
    [ $E->MRO ],
    [ $E, $::Object ],
    '... got the right MRO for E');    

is_deeply(
    [ $D->MRO ],
    [ $D, $::Object ],
    '... got the right MRO for D');       

is_deeply(
    [ $C->MRO ],
    [ $C, $D, $F, $::Object ],
    '... got the right MRO for C'); 

is_deeply(
    [ $B->MRO ],
    [ $B, $D, $E, $::Object ],
    '... got the right MRO for B');     

is_deeply(
    [ $A->MRO ],
    [ $A, $B, $C, $D, $E, $F, $::Object ],
    '... got the right MRO for A');      

=pod

"Serious order disagreement" #From Guido
class O: pass
class X(O): pass
class Y(O): pass
class A(X,Y): pass
class B(Y,X): pass
try:
    class Z(A,B): pass #creates Z(A,B) in Python 2.2
except TypeError:
    pass # Z(A,B) cannot be created in Python 2.3

=cut

my $X = class 'X' => { is => [ $::Object ] };
my $Y = class 'Y' => { is => [ $::Object ] };
my $XY = class 'XY' => { is => [ $X, $Y ] };
my $YX = class 'YX' => { is => [ $Y, $X ] };

throws_ok {
    class 'Z' => { is => [ $XY, $YX ] };
} qr/Inconsistent hierarchy/, '... got the right error with an inconsistent hierarchy';

=pod

"My second example"
class O: pass
class F(O): pass
class E(O): pass
class D(O): pass
class C(D,F): pass
class B(E,D): pass
class A(B,C): pass

                           6
                          ---
Level 3                  | O |
                       /  ---  \
                      /    |    \
                     /     |     \
                    /      |      \
                  ---     ---    ---
Level 2        2 | E | 4 | D |  | F | 5
                  ---     ---    ---
                   \      / \     /
                    \    /   \   /
                     \  /     \ /
                      ---     ---
Level 1            1 | B |   | C | 3
                      ---     ---
                       \       /
                        \     /
                          ---
Level 0                0 | A |
                          ---

>>> A.mro()
(<class '__main__.A'>, <class '__main__.B'>, <class '__main__.E'>,
<class '__main__.C'>, <class '__main__.D'>, <class '__main__.F'>,
<type 'object'>)

=cut

my $F2 = class 'F2' => { is => [ $::Object ] };
my $E2 = class 'E2' => { is => [ $::Object ] };
my $D2 = class 'D2' => { is => [ $::Object ] };
my $C2 = class 'C2' => { is => [ $D2, $F2 ] };
my $B2 = class 'B2' => { is => [ $E2, $D2 ] };
my $A2 = class 'A2' => { is => [ $B2, $C2 ] };


is_deeply(
    [ $A2->MRO ],
    [ $A2, $B2, $E2, $C2, $D2, $F2, $::Object ],
    '... got the right MRO for A2');      

=pod

   C
  / \
 /   \
A     B
 \   /
  \ /
   D

=cut

my $Diamond_C = class 'Diamond_C' => { is => [ $::Object ] };
my $Diamond_A = class 'Diamond_A' => { is => [ $Diamond_C ] };
my $Diamond_B = class 'Diamond_B' => { is => [ $Diamond_C ] };
my $Diamond_D = class 'Diamond_D' => { is => [ $Diamond_A, $Diamond_B ] };

is_deeply(
    [ $Diamond_D->MRO ],
    [ $Diamond_D, $Diamond_A, $Diamond_B, $Diamond_C, $::Object ],
    '... got the right MRO for diamond inheritance');      

=pod

      $::Object
           ^
           |
        LifeForm 
         ^    ^
        /      \
   Sentient    BiPedal
      ^          ^
      |          |
 Intelligent  Humanoid
       ^        ^
        \      /
         Vulcan

example taken from: L<http://gauss.gwydiondylan.org/books/drm/drm_50.html>

 define class <sentient> (<life-form>) end class;
 define class <bipedal> (<life-form>) end class;
 define class <intelligent> (<sentient>) end class;
 define class <humanoid> (<bipedal>) end class;
 define class <vulcan> (<intelligent>, <humanoid>) end class;

=cut

my $LifeForm    = class 'LifeForm'    => { is => [ $::Object ] };
my $Sentient    = class 'Sentient'    => { is => [ $LifeForm ] };
my $BiPedal     = class 'BiPedal'     => { is => [ $LifeForm ] };
my $Intelligent = class 'Intelligent' => { is => [ $Sentient ] };
my $Humanoid    = class 'Humanoid'    => { is => [ $BiPedal  ] };
my $Vulcan = class 'Vulcan' => {
    is => [ $Intelligent, $Humanoid ]
};

is_deeply(
    [ $Vulcan->MRO ],
    [ $Vulcan, $Intelligent, $Sentient, $Humanoid, $BiPedal, $LifeForm, $::Object ],
    '... got the right list for the Vulcan Dylan Example');  

=pod

More Dylan examples

from L<http://www.webcom.com/haahr/dylan/linearization-oopsla96.html>

=cut

my $Boat = class 'Boat' => { is => [ $::Object ] };

my $DayBoat = class 'DayBoat' => { is => [ $Boat ] };
my $WheelBoat = class 'WheelBoat' => { is => [ $Boat ] };

my $EngineLess = class 'EngineLess' => { is => [ $DayBoat ] };
my $SmallMultiHull = class 'SmallMultiHull' => { is => [ $DayBoat ] };

my $PedalWheelBoat = class 'PedalWheelBoat' => { is => [ $EngineLess, $WheelBoat ] };

my $SmallCatamaran = class 'SmallCatamaran' => { is => [ $SmallMultiHull ] };

my $Pedalo = class 'Pedalo' => { is => [ $PedalWheelBoat, $SmallCatamaran ] };

is_deeply(
    [ $PedalWheelBoat->MRO ],
    [ $PedalWheelBoat, $EngineLess, $DayBoat, $WheelBoat, $Boat, $::Object ],
    '... got the right list for PedalWheelBoat in the Pedalo Dylan Example');  

is_deeply(
    [ $SmallCatamaran->MRO ],
    [ $SmallCatamaran, $SmallMultiHull, $DayBoat, $Boat, $::Object ],
    '... got the right list for SmallCatamaran in the Pedalo Dylan Example');  

is_deeply(
    [ $Pedalo->MRO ],
    [ $Pedalo, $PedalWheelBoat, $EngineLess, $SmallCatamaran, $SmallMultiHull, $DayBoat, $WheelBoat, $Boat, $::Object ],
    '... got the right list for the Pedalo Dylan Example');