The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

use strict;
use warnings;

use Test::More no_plan => 1;

use Perl6::MetaModel;

use_ok('Perl6::MetaModel::Parser');

{ # bare class
    my $p = Perl6::MetaModel::Parser->new();
    isa_ok($p, 'Perl6::MetaModel::Parser');
    
    my $source = "class Foo {}";

    $p->parse($source);
    
    my $Foo = $::{'*'}->FETCH('Foo');
    isa_ok($Foo, 'Class');
    isa_ok($Foo, 'Object');   
    isa_ok($Foo, 'Foo');    
    
    is($Foo->name, 'Foo', '... got the right name for class');    
}

{ # class with one attribute
    my $p = Perl6::MetaModel::Parser->new();
    isa_ok($p, 'Perl6::MetaModel::Parser');

    my $source = 'class Bar { has $.baz; }';

    $p->parse($source);

    my $Bar = $::{'*'}->FETCH('Bar');
    isa_ok($Bar, 'Class');
    isa_ok($Bar, 'Object');  
    isa_ok($Bar, 'Bar');    

    is($Bar->name, 'Bar', '... got the right name for class');    
    ok($Bar->has_attribute('$.baz'), '... got the $.baz attribute for class');        
}

{ # class with multiple attributes
    my $p = Perl6::MetaModel::Parser->new();
    isa_ok($p, 'Perl6::MetaModel::Parser');

    my $source = q|
    class Baz { 
        has $.baz; 
        has @.bar;         
        has %.foo;                 
    }
    |;

    $p->parse($source);

    my $Baz = $::{'*'}->FETCH('Baz');
    isa_ok($Baz, 'Class');
    isa_ok($Baz, 'Object');  
    isa_ok($Baz, 'Baz');    

    is($Baz->name, 'Baz', '... got the right name for class');    
    ok($Baz->has_attribute('$.baz'), '... got the $.baz attribute for class'); 
    ok($Baz->has_attribute('@.bar'), '... got the @.bar attribute for class'); 
    ok($Baz->has_attribute('%.foo'), '... got the %.foo attribute for class'); 
                   
}

{ # two classes defined
    my $p = Perl6::MetaModel::Parser->new();
    isa_ok($p, 'Perl6::MetaModel::Parser');

    my $source = q|
    class One {}
    class Two {}    
    |;

    $p->parse($source);

    my $One = $::{'*'}->FETCH('One');
    isa_ok($One, 'Object');      
    isa_ok($One, 'One');
    is($One->name, 'One', '... got the right name for class');    
    
    my $Two = $::{'*'}->FETCH('Two');
    isa_ok($Two, 'Object');      
    isa_ok($Two, 'Two');
    is($Two->name, 'Two', '... got the right name for class');    

}

{ # two classes defined w/ attributes
    my $p = Perl6::MetaModel::Parser->new();
    isa_ok($p, 'Perl6::MetaModel::Parser');

    my $source = q|
    class Three {
        has @.six;
    }
    class Four { has $.five; }    
    |;

    $p->parse($source);

    my $Three = $::{'*'}->FETCH('Three');
    isa_ok($Three, 'Object');  
    isa_ok($Three, 'Three');
    is($Three->name, 'Three', '... got the right name for class');  
    ok($Three->has_attribute('@.six'), '... got the @.six attribute for class');       
    is_deeply(
        [ $Three->get_attribute_list ],
        [ '@.six' ],
        '... got the right list of attributes');
        
    my $Four = $::{'*'}->FETCH('Four');
    isa_ok($Four, 'Object');      
    isa_ok($Four, 'Four');
    is($Four->name, 'Four', '... got the right name for class');  
    ok($Four->has_attribute('$.five'), '... got the $.five attribute for class');       
    is_deeply(
        [ $Four->get_attribute_list ],
        [ '$.five' ],
        '... got the right list of attributes');        

}