Author: allison
Date: Tue Oct 2 12:40:14 2007
New Revision: 21759
Modified:
branches/pdd15oo/docs/pdds/pdd15_objects.pod
branches/pdd15oo/src/ops/object.ops
branches/pdd15oo/t/oo/new.t
Log:
[pdd15oo] The 'get_class' opcode returns PMCNULL when the requested class
doesn't exist.
Modified: branches/pdd15oo/docs/pdds/pdd15_objects.pod
==============================================================================
--- branches/pdd15oo/docs/pdds/pdd15_objects.pod (original)
+++ branches/pdd15oo/docs/pdds/pdd15_objects.pod Tue Oct 2 12:40:14 2007
@@ -1034,6 +1034,8 @@
in that namespace object. A key looks for the class in the namespace identified
by the multilevel key relative to the currently selected HLL.
+If the class doesn't exist, it returns a null PMC.
+
=item typeof
$S1 = typeof $P2
Modified: branches/pdd15oo/src/ops/object.ops
==============================================================================
--- branches/pdd15oo/src/ops/object.ops (original)
+++ branches/pdd15oo/src/ops/object.ops Tue Oct 2 12:40:14 2007
@@ -398,35 +398,13 @@
=cut
inline op get_class(out PMC, in STR) :object_classes {
- PMC *class_name, *classobj;
- opcode_t *next = expr NEXT();
-
- class_name = pmc_new(interp, enum_class_String);
- VTABLE_set_string_native(interp, class_name, $2);
- classobj = Parrot_oo_get_class(interp, class_name);
-
- if (PMC_IS_NULL(classobj))
- real_exception(interp, next, NO_CLASS, "Class '%Ss' doesn't exist", $2);
-
- $1 = classobj;
-
- goto ADDRESS(next);
+ $1 = Parrot_oo_get_class_str(interp, $2);
+ goto NEXT();
}
inline op get_class(out PMC, in PMC) :object_classes {
- PMC *classobj;
- opcode_t *next = expr NEXT();
-
- classobj = Parrot_oo_get_class(interp, $2);
-
- if (PMC_IS_NULL(classobj)) {
- STRING *name = readable_name(interp, $2);
- real_exception(interp, next, NO_CLASS, "Class '%Ss' doesn't exist",
name);
- }
-
- $1 = classobj;
-
- goto ADDRESS(next);
+ $1 = Parrot_oo_get_class(interp, $2);
+ goto NEXT();
}
###############################################################################
Modified: branches/pdd15oo/t/oo/new.t
==============================================================================
--- branches/pdd15oo/t/oo/new.t (original)
+++ branches/pdd15oo/t/oo/new.t Tue Oct 2 12:40:14 2007
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 15;
+use Parrot::Test tests => 18;
=head1 NAME
@@ -469,6 +469,53 @@
bar blue
OUT
+pir_output_is( <<'CODE', <<'OUT', 'get_class retrieves a high-level class
object');
+.sub main :main
+ $P0 = newclass 'Foo'
+ $S1 = typeof $P0
+ say $S1
+
+ $P1 = get_class 'Foo'
+ $S1 = typeof $P1
+ say $S1
+
+ $P2 = new $P1
+ $S1 = typeof $P2
+ say $S1
+.end
+CODE
+Class
+Class
+Foo
+OUT
+
+pir_output_is( <<'CODE', <<'OUT', 'get_class retrieves a proxy class object');
+.sub main :main
+ $P1 = get_class 'String'
+ $S1 = typeof $P1
+ say $S1
+
+ $P2 = new $P1
+ $S1 = typeof $P2
+ say $S1
+.end
+CODE
+PMCProxy
+String
+OUT
+
+pir_output_is( <<'CODE', <<'OUT', "get_class retrieves a class object that
doesn't exist");
+.sub main :main
+ $P1 = get_class 'Murple'
+ if null $P1 goto not_defined
+ say "Class is defined. Shouldn't be."
+ end
+ not_defined:
+ say "Class isn't defined."
+.end
+CODE
+Class isn't defined.
+OUT
# Local Variables:
# mode: cperl
