#!/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');
}