Author: allison
Date: Mon May 14 00:31:46 2007
New Revision: 18535
Modified:
trunk/include/parrot/enums.h
trunk/src/inter_call.c
trunk/src/pmc/parrotobject.pmc
trunk/t/pmc/parrotobject.t
Log:
Inject the invocant into the signature of vtable overrides for "invoke".
Applies RT #42919 (Alek Storm) with some modifications.
Modified: trunk/include/parrot/enums.h
==============================================================================
--- trunk/include/parrot/enums.h (original)
+++ trunk/include/parrot/enums.h Mon May 14 00:31:46 2007
@@ -61,7 +61,8 @@
/* unused - 0x040 */
PARROT_ARG_OPTIONAL = 0x080, /* 128 */
PARROT_ARG_OPT_FLAG = 0x100, /* 256 prev optional was set */
- PARROT_ARG_NAME = 0x200 /* 512 this String is an arg name */
+ PARROT_ARG_NAME = 0x200, /* 512 this String is an arg name */
+ PARROT_ARG_INVOCANT = 0x400 /* 1024 arg is method invocant */
/* more to come soon */
} Call_bits_enum_t;
Modified: trunk/src/inter_call.c
==============================================================================
--- trunk/src/inter_call.c (original)
+++ trunk/src/inter_call.c Mon May 14 00:31:46 2007
@@ -311,7 +311,10 @@
: CTX_REG_NUM(st->src.ctx, idx);
break;
case PARROT_ARG_PMC:
- UVal_pmc(st->val) = constant ? st->src.ctx->constants[idx]->u.key
+ if (st->src.sig & PARROT_ARG_INVOCANT)
+ UVal_pmc(st->val) = CONTEXT(interp->ctx)->current_object;
+ else
+ UVal_pmc(st->val) = constant ?
st->src.ctx->constants[idx]->u.key
: CTX_REG_PMC(st->src.ctx, idx);
if (st->src.sig & PARROT_ARG_FLATTEN) {
Modified: trunk/src/pmc/parrotobject.pmc
==============================================================================
--- trunk/src/pmc/parrotobject.pmc (original)
+++ trunk/src/pmc/parrotobject.pmc Mon May 14 00:31:46 2007
@@ -557,6 +557,59 @@
/*
+=item C<opcode_t *invoke(void *next)>
+
+Invokes the current object as a subroutine.
+
+=cut
+
+*/
+
+ opcode_t* invoke(void* next) {
+ STRING *meth = CONST_STRING(INTERP, "invoke");
+ PMC *sub = Parrot_find_vtable_meth(INTERP, SELF, meth);
+ opcode_t* save_current_args;
+
+ if (PMC_IS_NULL(sub)) {
+ PMC *mro = SELF->vtable->mro;
+
+ if (VTABLE_elements(INTERP, mro) == 1)
+ return SUPER(next);
+ else {
+ PMC *parent = VTABLE_get_pmc_keyed_int(INTERP,
+ SELF->vtable->mro, 1);
+
+ if (PObj_is_class_TEST(parent))
+ return SUPER(next);
+
+ return deleg_pmc.SUPER(next);
+ }
+ }
+
+ /* Since invoke() is a normal method, 'self' must be passed as the
+ * first argument, but because this looks like a non-method call in
+ * PIR, the args signature doesn't have it, so we have to get the
+ * args signature and unshift 'self' onto it. */
+ PMC *old_sig =
CONTEXT(interp->ctx)->constants[*(interp->current_args+1)]->u.key;
+ INTVAL sig_len = VTABLE_elements(interp, old_sig) + 1;
+ int i;
+
+ PMC *meth_sig = pmc_new(interp, enum_class_FixedIntegerArray);
+ VTABLE_set_integer_native(interp, meth_sig, sig_len);
+
+ VTABLE_set_integer_keyed_int(interp, meth_sig, 0, PARROT_ARG_PMC |
PARROT_ARG_INVOCANT);
+ CTX_REG_PMC(CONTEXT(interp->ctx), 0) = SELF;
+ for ( i = 1; i < sig_len; i++ )
+ VTABLE_set_integer_keyed_int(interp, meth_sig, i,
VTABLE_get_integer_keyed_int(interp, old_sig, i-1));
+
+ interp->args_signature = meth_sig;
+ interp->current_args++;
+
+ INTERP->current_object = SELF;
+ return VTABLE_invoke(interp, sub, next);
+ }
+/*
+
=item C<void visit(visit_info *info)>
This is used by freeze/thaw to visit the contents of the object.
Modified: trunk/t/pmc/parrotobject.t
==============================================================================
--- trunk/t/pmc/parrotobject.t (original)
+++ trunk/t/pmc/parrotobject.t Mon May 14 00:31:46 2007
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 11;
+use Parrot::Test tests => 12;
=head1 NAME
@@ -195,7 +195,7 @@
pir_output_is( <<'CODE', <<'OUT', 'RT#41733 - Execution ends after returning
from invoke' );
.namespace ['Foo']
-.sub invoke :vtable
+.sub invoke :method :vtable
say "you invoked me!"
.return()
.end
@@ -214,7 +214,7 @@
pir_output_is( <<'CODE', <<'OUT', 'params/returns from overridden invoke' );
.namespace ['Foo']
-.sub invoke :vtable
+.sub invoke :method :vtable
.param int a
print a
print "\n"
@@ -237,7 +237,7 @@
pir_error_output_like( <<'CODE', <<'OUT', 'RT#41732' );
.namespace ['Foo']
-.sub invoke :vtable
+.sub invoke :method :vtable
.param pmc a
say 'hi'
.end
@@ -248,7 +248,46 @@
$P1()
.end
CODE
-/1 params expected/
+/2 params expected/
+OUT
+
+pir_output_is( <<'CODE', <<'OUT', 'overridden invoke in parent class' );
+.sub main :main
+ $P0 = newclass "FooParent"
+ $P2 = subclass "FooParent", "Foo"
+ $P1 = new "Foo"
+ say "before"
+ $P1("bar", "baa")
+ say "after"
+.end
+
+.namespace ["FooParent"]
+.sub 'invoke' :method :vtable
+ .param pmc bar
+ .param pmc baa
+ say bar
+ say baa
+ $I0 = defined self
+ if $I0 goto is_defined
+ say "self not defined"
+ is_defined:
+ $S1 = typeof self
+ say $S1
+ self.'baz'()
+ say "inside"
+.end
+
+.sub 'baz' :method
+ say "baz"
+.end
+CODE
+before
+bar
+baa
+Foo
+baz
+inside
+after
OUT
# '
