make a humble beginning on the tests for the Perl 6 metamodel, adding
a README for the work. This chooses the top-level names "Class" and "MetaClass"
for the names of the perl6 metamodel. API largely stolen from Class::MOP
Signed-off-by: Sam Vilain <[EMAIL PROTECTED]>
---
This was almost a direct port of the first test from the Class::MOP suite.
See http://search.cpan.org/src/STEVAN/Class-MOP-0.42/t/001_basic.t for the
original.
languages/perl6/t/10-metamodel/001-basic.t | 121 ++++++++++++++++++++++++++++
languages/perl6/t/10-metamodel/README.txt | 11 +++
2 files changed, 132 insertions(+), 0 deletions(-)
create mode 100644 languages/perl6/t/10-metamodel/001-basic.t
create mode 100644 languages/perl6/t/10-metamodel/README.txt
diff --git a/languages/perl6/t/10-metamodel/001-basic.t b/languages/perl6/t/10-metamodel/001-basic.t
new file mode 100644
index 0000000..ec84938
--- /dev/null
+++ b/languages/perl6/t/10-metamodel/001-basic.t
@@ -0,0 +1,121 @@
+# -*- pir -*-
+
+# based on Class::MOP t/001_basic.t
+
+.sub _main :main
+ load_bytecode 'library/Test/More.pir'
+
+ .local pmc exports, curr_namespace, test_namespace
+ curr_namespace = get_namespace
+ test_namespace = get_namespace [ "Test::More" ]
+ exports = split " ", "plan diag ok is is_deeply like isa_ok use_ok"
+ test_namespace."export_to"(curr_namespace, exports)
+ plan( 2 )
+
+ use_ok( 'Class' )
+
+ # setup classes for test
+ .local pmc FooClass
+ FooClass = new 'Class'( 'name' => 'Foo',
+ 'version' => 0.01 )
+
+ .local pmc BarClass, supers
+ supers = new ResizablePMCArray
+ supers.push(FooClass)
+ BarClass = new 'Class'( 'name' => 'Bar',
+ 'superclasses' => supers,
+ 'authority' => 'cpan:JRANDOM',
+ )
+
+ # port tests
+ .local FooMeta
+ FooMeta = FooClass.'meta'()
+ isa_ok(FooMeta, 'MetaClass')
+
+ .local BarMeta
+ BarMeta = Bar.'meta'()
+ isa_ok(FooMeta, 'MetaClass')
+
+ $S0 = FooMeta.'name'()
+ is($S0, 'Foo', '... Foo.name == Foo')
+ $S0 = BarMeta.'name'()
+ is($S0, 'Bar', '... Bar.name == Bar')
+
+ $S0 = FooMeta.'version'()
+ is($S0, '0.01', '... Foo->version == 0.01')
+ $P0 = BarMeta.'version'()
+ $I0 = defined $P0
+ is($I0, 0, '... Bar->version == undef')
+
+ $P0 = FooMeta.'authority'()
+ $I0 = defined $P0
+ is($I0, 0, '... Foo->authority == undef')
+ $S0 = BarMeta.'authority'()
+ is($P0, 'cpan:JRANDOM', '... Bar->authority == cpan:JRANDOM')
+
+ $S0 = FooMeta.'identifier'()
+ is($S0, 'Foo-0.01', '... Foo->identifier == Foo-0.01')
+ $S0 = BarMeta.'identifier'()
+ is($S0, 'Bar-cpan:JRANDOM', '... Bar->identifier == Bar-cpan:JRANDOM')
+
+ $P0 = FooMeta.'superclasses'()
+ $I0 = sizeof $P0
+ is($I0, 1, '... Foo has no real superclasses')
+ $P0 = $P0[0]
+ $S0 = $P0.'name'()
+ is($S0, 'Object', 'Foo is an Object')
+
+ $P0 = BarMeta.'superclasses'()
+ $I0 = sizeof $P0
+ is($I0, 1, '... Bar has a superclass')
+ $P1 = $P0[0]
+ is($P1, FooMeta, '... Bar->superclasses == (Foo)')
+
+# ??
+#$Foo->superclasses('UNIVERSAL');
+#is_deeply([$Foo->superclasses], ['UNIVERSAL'], '... Foo->superclasses == (UNIVERSAL) now');
+
+ $P0 = FooMeta.'class_precedence_list'()
+ $P1 = [ 'Foo', 'Object' ],
+ is_deeply( $P0, $P1, '... Foo->class_precedence_list == (Foo, Object)')
+
+ $P0 = BarMeta.'class_precedence_list'()
+ $P1 = [ 'Bar', 'Foo', 'Object' ],
+ is_deeply( $P0, $P1, '... Bar->class_precedence_list == (Bar, Foo, Object)')
+
+ # create a class using MetaClass.create
+
+ .local pmc Class_mc, BazMeta, Baz_mc
+ Class_mc = getclass 'Class'
+ supers = new ResizablePMCArray
+ supers.push(BarMeta)
+ BazMeta = Class_mc.create( name => 'Baz',
+ version => '0.10',
+ authority => 'cpan:YOMAMA',
+ superclasses => supers )
+
+ isa_ok(BazMeta, 'Class::MOP::Class')
+ Baz_mc = getclass 'BazMeta'
+ is(BazMeta, Baz_mc, '... our metaclasses are singletons')
+
+ $S0 = BazMeta.'name'()
+ is($S0, 'Baz', '... Baz->name == Baz')
+ $S0 = BazMeta.'version'()
+ is($S0, '0.10', '... Baz->version == 0.10')
+ $S0 = BazMeta.'authority'()
+ is($S0, 'cpan:YOMAMA', '... Baz->authority == YOMAMA')
+
+ $S0 = BazMeta.'identifier'()
+ is($S0, 'Baz-0.10-cpan:YOMAMA', '... Baz->identifier == Baz-0.10-cpan:YOMAMA')
+
+ $P0 = BazMeta.'superclasses'()
+ supers = new ResizablePMCArray
+ supers.push(BarMeta)
+ is_deeply($P0, supers, '... Baz->superclasses == (Bar)')
+
+ $P0 = BazMeta.'class_precedence_list'()
+ $P1 = [ 'Baz', 'Bar', 'Foo', 'Object' ],
+ is_deeply($P0, $P1,
+ '... Baz->class_precedence_list == (Baz, Bar, Foo, Object)');
+
+.end
diff --git a/languages/perl6/t/10-metamodel/README.txt b/languages/perl6/t/10-metamodel/README.txt
new file mode 100644
index 0000000..8ae3ef6
--- /dev/null
+++ b/languages/perl6/t/10-metamodel/README.txt
@@ -0,0 +1,11 @@
+Metamodel tests
+~~~~~~~~~~~~~~~
+These metamodel tests are designed to be functional unit tests for the
+code that drives the Perl 6 metamodel. In a sense, they should be as
+minimal as possible; most of the tests for the functionality should be
+either in the normative Perl 6 test suite in the pugs repository, or
+in the cross-language tests under t/oo/ at the top level of the parrot
+tree.
+
+To make this clear, these tests should probably be written in PIR at
+this point.
