cvsuser 04/07/20 02:35:05
Modified: imcc pcc.c
src objects.c
t/pmc objects.t
Log:
Pie-thon 81 - ParrotClass is object, subclassing it gives a new class
Revision Changes Path
1.69 +1 -1 parrot/imcc/pcc.c
Index: pcc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pcc.c,v
retrieving revision 1.68
retrieving revision 1.69
diff -u -w -r1.68 -r1.69
--- pcc.c 19 Jul 2004 11:00:23 -0000 1.68
+++ pcc.c 20 Jul 2004 09:34:54 -0000 1.69
@@ -375,7 +375,7 @@
i0 = NULL;
label1 = label2 = NULL;
ps = pe = sub->pcc_sub->pragma & P_PROTOTYPED;
- if (sub->pcc_sub->pragma & P_NONE) {
+ if (!pe && (sub->pcc_sub->pragma & P_NONE)) {
ps = 0; pe = 1;
/* subroutine can handle both */
i0 = get_pasm_reg("I0");
1.105 +9 -4 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -w -r1.104 -r1.105
--- objects.c 16 Jul 2004 12:15:34 -0000 1.104
+++ objects.c 20 Jul 2004 09:34:59 -0000 1.105
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.104 2004/07/16 12:15:34 leo Exp $
+$Id: objects.c,v 1.105 2004/07/20 09:34:59 leo Exp $
=head1 NAME
@@ -268,10 +268,15 @@
if (n > 1)
internal_exception(1, "subclass: unimp multiple parents");
base_class = VTABLE_get_pmc_keyed_int(interpreter, tuple, 0);
- if (0&&PMC_struct_val(base_class) == (void*)0xdeadbeef)
- base_class = pmc_new(interpreter, base_class->vtable->base_type);
}
-
+ /*
+ * ParrotClass is the baseclass anyway, so build just a new class
+ */
+ if (base_class->vtable->base_type == enum_class_ParrotClass) {
+ PMC* class = pmc_new(interpreter, enum_class_ParrotClass);
+ Parrot_new_class(interpreter, class, child_class_name);
+ return class;
+ }
parent_is_class = PObj_is_class_TEST(base_class);
child_class = pmc_new(interpreter, enum_class_ParrotClass);
1.51 +23 -2 parrot/t/pmc/objects.t
Index: objects.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/objects.t,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -w -r1.50 -r1.51
--- objects.t 2 Jul 2004 08:23:28 -0000 1.50
+++ objects.t 20 Jul 2004 09:35:04 -0000 1.51
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: objects.t,v 1.50 2004/07/02 08:23:28 leo Exp $
+# $Id: objects.t,v 1.51 2004/07/20 09:35:04 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 46;
+use Parrot::Test tests => 47;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "findclass (base class)");
@@ -1514,3 +1514,24 @@
MyInt2(42)
OUTPUT
};
+
+output_is(<<'CODE', <<'OUTPUT', "subclassing ParrotClass");
+##PIR##
+.sub main @MAIN
+ .local pmc cl
+ .local pmc parent
+ parent = getclass "ParrotClass"
+ cl = subclass parent, "Foo"
+ print "ok 1\n"
+ .local pmc o
+ o = cl()
+ print "ok 2\n"
+ $S0 = classname o
+ print $S0
+ print "\n"
+.end
+CODE
+ok 1
+ok 2
+Foo
+OUTPUT
