Author: allison
Date: Tue Feb 6 01:09:30 2007
New Revision: 16907
Modified:
trunk/compilers/smop/Class.pir
trunk/compilers/smop/t/class.t
Log:
[smop]: A bit of hackery to add an additional Meta level (from Sam).
Modified: trunk/compilers/smop/Class.pir
==============================================================================
--- trunk/compilers/smop/Class.pir (original)
+++ trunk/compilers/smop/Class.pir Tue Feb 6 01:09:30 2007
@@ -42,13 +42,38 @@
.sub onload :load
.local pmc class
+ load_bytecode "compilers/smop/Attribute.pir"
class = newclass "Class"
- addattribute class, "name"
- addattribute class, "namespace"
- addattribute class, "_parrotclass"
- addattribute class, "attributes"
- addattribute class, "methods"
- addattribute class, "superclasses"
+
+ .local pmc atts, attribs
+ atts = split ", ", "name, namespace, _parrotclass, attributes, methods,
superclasses"
+ attribs = new ResizablePMCArray
+ .local pmc iter, new_attribute
+ iter = new Iterator, atts
+ iter = 0
+iter_loop:
+ unless iter goto iter_end
+ $S1 = shift iter
+ addattribute class, $S1
+ new_attribute = new 'Attribute'
+ new_attribute.'name'($S1)
+ new_attribute.'class'(class)
+ push attribs, new_attribute
+ goto iter_loop
+iter_end:
+
+ # we sidestep the MetaModel bootstrap problem by building the
+ # MetaClass manually
+ $P0 = new String
+ $P0 = "Class"
+ .local pmc class_mc
+ class_mc = new "Class"
+ setattribute class_mc, "name", $P0
+ setattribute class_mc, "_parrotclass", class
+ class_mc.init()
+ setattribute class_mc, "attributes", attribs
+ store_global "class_object", class_mc
+
.end
Modified: trunk/compilers/smop/t/class.t
==============================================================================
--- trunk/compilers/smop/t/class.t (original)
+++ trunk/compilers/smop/t/class.t Tue Feb 6 01:09:30 2007
@@ -15,20 +15,18 @@
.IMPORT( 'Test::More', 'ok', _ )
.IMPORT( 'Test::More', 'is', _ )
- plan( 10 )
+ plan( 12 )
- .local pmc class, init_args, init_attribs
- init_args = new Hash
+ .local pmc class, class_class, init_attribs
init_attribs = new Hash
init_attribs['ear'] = 'Str'
init_attribs['tail'] = 'Str'
- init_args['name'] = 'Dog'
- init_args['attributes'] = init_attribs
-
- class = new 'Class', init_args # equiv to newclass 'Dog'
+
+ class_class = find_class("Class")
+ class = class_class.'new'( 'name' => "Dog", 'attributes' => init_attribs )
$P1 = class.name()
- is($P1, "Dog", "created a new Class")
+ is($P1, "Dog", "created a new Class via MetaClass")
$P1 = class.name()
is($P1, "Dog", "Class accessor doesn't destroy value")
@@ -75,6 +73,19 @@
fail("SKIP - no attribute")
NEXT:
+ .local pmc init_args
+ init_args = new Hash
+ init_args['name'] = 'Sheep'
+ class = new "Class", init_args
+ $P0 = find_class("Sheep")
+ $I0 = defined $P0
+ ok($I0, "can construct classes with 'new \"Class\"' still")
+
+ $P0 = new "Sheep"
+ $I0 = defined $P0
+ ok($I0, "'new \"Class\"' makes working classes")
+
+
.end
.namespace['Dog']
