Author: jonathan
Date: Sun Apr 15 12:55:37 2007
New Revision: 18229
Modified:
trunk/src/pmc/class.pmc
trunk/t/pmc/class.t
Log:
[PDD15]: Implement clone and clone_pmc vtable methods for the Class PMC. Test
both of 'em.
Modified: trunk/src/pmc/class.pmc
==============================================================================
--- trunk/src/pmc/class.pmc (original)
+++ trunk/src/pmc/class.pmc Sun Apr 15 12:55:37 2007
@@ -617,6 +617,65 @@
return metadata;
}
+/*
+
+=item C<PMC* clone()>
+
+Returns an anonymous copy of the class (with no name and no link to a
+namespace). Unsets the instantiated flag, allowing modifications.
+
+=cut
+
+*/
+
+ PMC* clone()
+ {
+ Parrot_Class *class = PARROT_CLASS(SELF);
+
+ /* Create the new class PMC, of the same type of this one (we may
+ * have been subclassed). */
+ PMC *copy = pmc_new(interp, SELF->vtable->base_type);
+
+ /* Clone parents, roles, methods, attributes and resolve data. We do
+ * not copy name/namespace related stuff (need anonymous clone) or
+ * stuff that gets computed on the first instantiation. */
+ Parrot_Class *new_class = PARROT_CLASS(copy);
+ new_class->parents = VTABLE_clone(interp, class->parents);
+ new_class->roles = VTABLE_clone(interp, class->roles);
+ new_class->methods = VTABLE_clone(interp, class->methods);
+ new_class->vtable_methods = VTABLE_clone(interp,
class->vtable_methods);
+ new_class->attrib_metadata = VTABLE_clone(interp,
class->attrib_metadata);
+ new_class->resolve_method = VTABLE_clone(interp,
class->resolve_method);
+
+ /* Return cloned class. */
+ return copy;
+ }
+
+/*
+
+=item C<PMC* clone_pmc(PMC *args)>
+
+Makes a copy of the class, then modifies or adds to it based upon the contents
+of the supplied initialization data. If a new name or namespace is not supplied
+in C<args> then the cloned class will be anonymous. The instantiated flag is
+unset to allow further modifications.
+
+=cut
+
+*/
+
+ PMC* clone_pmc(PMC *args)
+ {
+ /* Do the standard clone. */
+ PMC *copy = DYNSELF.clone();
+
+ /* Initialize it with the supplied arguments. */
+ init_class_from_hash(interp, copy, args);
+
+ /* Return cloned class. */
+ return copy;
+ }
+
/* **********************************************************************
* Below here are non-vtable methods that eventually will go in a role
* that is composed into here to optionally give a nice interface from
Modified: trunk/t/pmc/class.t
==============================================================================
--- trunk/t/pmc/class.t (original)
+++ trunk/t/pmc/class.t Sun Apr 15 12:55:37 2007
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 12;
=head1 NAME
@@ -315,6 +315,95 @@
ok 4 - inspect('attributes')
OUT
+pir_output_is( <<'CODE', <<'OUT', 'clone' );
+.sub 'test' :main
+ $P0 = new 'Hash'
+ $P0['name'] = 'Monkey'
+ $P1 = new 'Class', $P0
+ $P1.add_attribute('banana')
+ $P2 = $P1.'new'()
+ print "ok 1 - created class Monkey and instantiated it\n"
+
+ $P3 = clone $P1
+ print "ok 2 - cloned class Monkey\n"
+
+ $S1 = $P3.'inspect'('name')
+ if $S1 == "" goto ok_3
+ print "not "
+ok_3:
+ print "ok 3 - name is empty\n"
+
+ $P4 = $P3.'inspect'('namespace')
+ if null $P4 goto ok_4
+ print "not "
+ok_4:
+ print "ok 4 - namespace is null\n"
+
+ $P4 = $P3.'inspect'('attributes')
+ $I0 = elements $P4
+ if $I0 == 1 goto ok_5
+ print "not "
+ok_5:
+ print "ok 5 - attribute survived cloning\n"
+
+ $P3.add_attribute('jungle')
+ print "ok 6 - can modify cloned class\n"
+.end
+CODE
+ok 1 - created class Monkey and instantiated it
+ok 2 - cloned class Monkey
+ok 3 - name is empty
+ok 4 - namespace is null
+ok 5 - attribute survived cloning
+ok 6 - can modify cloned class
+OUT
+
+pir_output_is( <<'CODE', <<'OUT', 'clone_pmc' );
+.sub 'test' :main
+ $P0 = new 'Hash'
+ $P0['name'] = 'Monkey'
+ $P1 = new 'Class', $P0
+ $P1.add_attribute('banana')
+ $P2 = $P1.'new'()
+ print "ok 1 - created class Monkey and instantiated it\n"
+
+ $P0 = new 'Hash'
+ $P0['name'] = 'Mandrill'
+ $P3 = clone $P1, $P0
+ print "ok 2 - cloned class Monkey with Hash argument\n"
+
+ $S1 = $P3.'inspect'('name')
+ if $S1 == "Mandrill" goto ok_3
+ print "not "
+ok_3:
+ print "ok 3 - name is new one set in the Hash\n"
+
+ $P4 = $P3.'inspect'('namespace')
+ $S1 = $P4
+ if $S1 == 'Mandrill' goto ok_4
+ print "not "
+ok_4:
+ print "ok 4 - namespace is Mandrill too\n"
+
+ $P4 = $P3.'inspect'('attributes')
+ $I0 = elements $P4
+ if $I0 == 1 goto ok_5
+ print "not "
+ok_5:
+ print "ok 5 - attribute survived cloning\n"
+
+ $P3.add_attribute('jungle')
+ print "ok 6 - can modify cloned class\n"
+.end
+CODE
+ok 1 - created class Monkey and instantiated it
+ok 2 - cloned class Monkey with Hash argument
+ok 3 - name is new one set in the Hash
+ok 4 - namespace is Mandrill too
+ok 5 - attribute survived cloning
+ok 6 - can modify cloned class
+OUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
