Author: allison
Date: Mon Feb 5 22:05:13 2007
New Revision: 16906
Modified:
trunk/compilers/smop/Attribute.pir
trunk/compilers/smop/Class.pir
trunk/compilers/smop/t/class.t
Log:
[smop]: Adding features and tests for attributes in the class constructor.
Modified: trunk/compilers/smop/Attribute.pir
==============================================================================
--- trunk/compilers/smop/Attribute.pir (original)
+++ trunk/compilers/smop/Attribute.pir Mon Feb 5 22:05:13 2007
@@ -40,7 +40,19 @@
.return(rv)
.end
+.sub type :method
+ .param pmc type :optional
+ .param int got_type :opt_flag
+ .local pmc rv
+ rv = self._accessor( "type", type, got_type )
+ .return(rv)
+.end
.sub init :vtable :method
$P0 = new String
setattribute self, "name", $P0
.end
+
+.sub init_pmc :vtable :method
+ .param pmc init_args
+ self.init()
+.end
Modified: trunk/compilers/smop/Class.pir
==============================================================================
--- trunk/compilers/smop/Class.pir (original)
+++ trunk/compilers/smop/Class.pir Mon Feb 5 22:05:13 2007
@@ -9,6 +9,17 @@
Classes are instances of the C<Class> PMC. Currently implemented in PIR,
but ultimately implemented as low-level .pmc.
+=head1 SYNOPSIS
+
+ .local pmc class, init_args, obj
+ init_args = new Hash
+ init_args['name'] = 'MyClass'
+ class = new 'Class', init_args
+# class = newclass 'MyClass'
+
+ class.add_attribute('myattribute')
+ obj = class.'new'( 'myattribute' => "Foo" )
+
=head2 find_class
This subroutine prototypes the C<find_class> opcode. It looks up a class
@@ -33,21 +44,13 @@
.local pmc class
class = newclass "Class"
addattribute class, "name"
+ addattribute class, "namespace"
addattribute class, "_parrotclass"
addattribute class, "attributes"
addattribute class, "methods"
addattribute class, "superclasses"
.end
-=head2 new
-
- .local pmc class, init_args
- init_args = new Hash
- init_args['name'] = 'MyClass'
- class = new 'Class', init_args
-# class = newclass 'MyClass'
-
-=cut
.sub init :vtable :method
$P0 = new Hash
@@ -77,6 +80,14 @@
.include "compilers/smop/_accessor.pir"
+=head2 name
+
+The accessor for the name attribute. With no argument, it simply returns
+the current value for name. When passed an argument, it sets the name of
+the class, and also sets the association with a namespace.
+
+=cut
+
.sub name :method
.param pmc name :optional
.param int got_name :opt_flag
@@ -88,21 +99,22 @@
store_global name, "class_object", self # namespace entry for class object
$P1 = newclass name
setattribute self, "_parrotclass", $P1 # dummy old-style class object within
- #$P0 = get_namespace [name]
- #$P1 = get_namespace
- #.local pmc initpmc
- #initpmc = get_global "_init_pmc"
- #print "but... but... "
- #say name
- #print "and "
- #say initpmc
- #store_global name, "_init_pmc", initpmc
- #$P0.add_sub("init_pmc", init)
+ $P1 = get_namespace
+ setattribute self, "namespace", $P1 # class entry for namespace object
get_only:
.return(rv)
.end
+=head2 new
+
+ obj = class.'new'( 'myattrib' => "Foo" )
+
+Create a new instance object from the class object. It takes an optional
+slurpy, named list of attributes and values to initialize the object.
+
+=cut
+
.sub 'new' :method
.param pmc args :slurpy :named
@@ -116,6 +128,14 @@
.return(obj)
.end
+=head2 attributes
+
+An accessor for the attributes attribute of the class. It returns the a
+Hash of all attributes, with a key of the attribute name, and a value of
+the Attribute object. The accessor is set by a hash of attributes, with
+a key name and a value type.
+
+=cut
.sub attributes :method
.param pmc attribs :optional
@@ -129,7 +149,8 @@
iter_loop:
unless iter goto iter_end
$S1 = shift iter # NOTE: convert to hash to add attribute types
- self.add_attribute($S1)
+ $P1 = iter[$S1]
+ self.add_attribute($S1, $P1)
goto iter_loop
iter_end:
@@ -138,14 +159,27 @@
.return(rv)
.end
+=head2 add_attribute
+
+Adds a single attribute to the class. It takes a simple string name, and
+a simple string value for type.
+
+=cut
+
.sub 'add_attribute' :method
.param string attribute_name
- .param pmc init_args :slurpy :named
+ .param string attribute_type :optional
+ .param int got_type :opt_flag
+
.local pmc new_attribute, attributes
- new_attribute = new 'Attribute', init_args
+ new_attribute = new 'Attribute'
new_attribute.'name'(attribute_name)
new_attribute.'class'(self)
+ unless got_type goto no_type
+ new_attribute.'type'(attribute_type)
+no_type:
+
# store the attribute in the class
attributes = getattribute self, 'attributes'
attributes[attribute_name] = new_attribute
Modified: trunk/compilers/smop/t/class.t
==============================================================================
--- trunk/compilers/smop/t/class.t (original)
+++ trunk/compilers/smop/t/class.t Mon Feb 5 22:05:13 2007
@@ -15,11 +15,16 @@
.IMPORT( 'Test::More', 'ok', _ )
.IMPORT( 'Test::More', 'is', _ )
- plan( 6 )
+ plan( 10 )
- .local pmc class, init_args
+ .local pmc class, init_args, init_attribs
init_args = new Hash
+ 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'
$P1 = class.name()
@@ -33,17 +38,38 @@
$I0 = exists attributes['bark']
ok($I0, "added attribute to the class")
+ $I0 = exists attributes['tail']
+ ok($I0, "added second attribute to the class")
+ unless $I0 goto no_tail_attribute
+ $P1 = attributes['tail']
+ $S1 = $P1.type()
+ is($S1,'Str', "tail attribute has a value")
+ goto end_tail_attrib_test
+ no_tail_attribute:
+ fail("tail attribute doesn't exist")
+ end_tail_attrib_test:
+
$P0 = find_class('Dog')
$I0 = issame $P0, class
ok($I0, "find_class can find the class")
- $P0 = class.'new'( 'bark' => "Wooof" )
+ $P0 = class.'new'( 'bark' => "Wooof", 'tail' => 'long' )
+ $P1 = getattribute $P0, "tail"
+ $I0 = defined $P1
+ ok($I0, "got back a tail attribute object")
+ unless $I0 goto SKIPTAIL
+ is($P1, "long", "tail attribute has expected value")
+ goto NEXTTAIL
+SKIPTAIL:
+ fail("SKIP - no attribute")
+NEXTTAIL:
+
$P1 = getattribute $P0, "bark"
$I0 = defined $P1
ok($I0, "got back a bark attribute object")
unless $I0 goto SKIP
- is($P1, "Wooof", "create object via Dog.new()")
+ is($P1, "Wooof", "bark attribute has expected value")
goto NEXT
SKIP:
fail("SKIP - no attribute")
@@ -77,3 +103,11 @@
rv = self._accessor( "bark", bark, got_bark )
.return(rv)
.end
+
+.sub tail :method
+ .param pmc tail :optional
+ .param int got_tail :opt_flag
+ .local pmc rv
+ rv = self._accessor( "tail", tail, got_tail )
+ .return(rv)
+.end
