cvsuser 03/07/20 17:37:40
Modified: . object.ops
t/pmc objects.t
Log:
Implement classname op
Revision Changes Path
1.6 +11 -0 parrot/object.ops
Index: object.ops
===================================================================
RCS file: /cvs/public/parrot/object.ops,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- object.ops 17 Jul 2003 20:51:03 -0000 1.5
+++ object.ops 21 Jul 2003 00:37:38 -0000 1.6
@@ -181,6 +181,17 @@
=cut
inline op classname(out STR, in PMC) {
+ PMC* classname_pmc;
+
+ classname_pmc = VTABLE_get_pmc_keyed_int(interpreter,
+ (PMC *)PMC_data($2), 4);
+ if (classname_pmc) {
+ $1 = VTABLE_get_string(interpreter, classname_pmc);
+ }
+ else {
+ internal_exception(NO_CLASS, "Class doesn't exist");
+ }
+
goto NEXT();
}
1.2 +23 -1 parrot/t/pmc/objects.t
Index: objects.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/objects.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- objects.t 18 Jul 2003 18:15:54 -0000 1.1
+++ objects.t 21 Jul 2003 00:37:40 -0000 1.2
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 3;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "findclass (base class)");
@@ -40,4 +40,26 @@
1
1
0
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "classname");
+ newclass P1, "Foo"
+ classname S0, P1
+ print S0
+ print "\n"
+
+ subclass P2, P1, "Bar"
+ classname S1, P2
+ print S1
+ print "\n"
+
+ subclass P3, "Foo", "Baz"
+ classname S2, P3
+ print S2
+ print "\n"
+ end
+CODE
+Foo
+Bar
+Baz
OUTPUT
