cvsuser 04/11/22 05:52:32
Modified: src inter_run.c
t/pmc object-meths.t
Log:
better fix for the fix - proposed by Luke
Revision Changes Path
1.21 +28 -18 parrot/src/inter_run.c
Index: inter_run.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_run.c,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- inter_run.c 22 Nov 2004 12:07:22 -0000 1.20
+++ inter_run.c 22 Nov 2004 13:52:31 -0000 1.21
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_run.c,v 1.20 2004/11/22 12:07:22 leo Exp $
+$Id: inter_run.c,v 1.21 2004/11/22 13:52:31 leo Exp $
=head1 NAME
@@ -284,30 +284,40 @@
break;
case 'P': /* REG_PMC */
arg = va_arg(ap, PMC*);
- if (next[2] == 16)
- VTABLE_set_pmc_keyed_int(interpreter, p3, i++, arg);
- else
- REG_PMC(next[2]++) = arg;
/*
- * if this is a Key PMC with registers, pass on these
- * registers.
+ * If this is a Key PMC with registers, we have to clone
+ * the key.
+ *
* XXX make a distinct 'K' signature ?
*/
if (arg->vtable->base_type == enum_class_Key) {
- while (arg) {
- UINTVAL flags = PObj_get_FLAGS(arg);
- if (flags & KEY_register_FLAG) {
- INTVAL n = PMC_int_val(arg);
- if (flags & KEY_integer_FLAG)
- REG_INT(n) = BP_REG_INT(bp, n);
- else if (flags & KEY_pmc_FLAG)
- REG_PMC(n) = BP_REG_PMC(bp, n);
- else if (flags & KEY_string_FLAG)
- REG_STR(n) = BP_REG_STR(bp, n);
+ PMC *key;
+ INTVAL any_registers;
+
+ for (any_registers = 0, key = arg; key; ) {
+ if (PObj_get_FLAGS(key) & KEY_register_FLAG) {
+ any_registers = 1;
+ break;
}
- arg = key_next(interpreter, arg);
+ key = key_next(interpreter, key);
+ }
+
+ if (any_registers) {
+ struct parrot_regs_t *new_bp;
+ new_bp = interpreter->ctx.bp;
+ /* need old context */
+ interpreter->ctx.bp = bp;
+ /* clone sets key values according to refered
+ * register items
+ */
+ arg = VTABLE_clone(interpreter, arg);
+ interpreter->ctx.bp = new_bp;
}
}
+ if (next[2] == 16)
+ VTABLE_set_pmc_keyed_int(interpreter, p3, i++, arg);
+ else
+ REG_PMC(next[2]++) = arg;
break;
case 'N': /* REG_NUM */
if (next[3] == 16)
1.24 +37 -2 parrot/t/pmc/object-meths.t
Index: object-meths.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/object-meths.t,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- object-meths.t 22 Nov 2004 12:07:23 -0000 1.23
+++ object-meths.t 22 Nov 2004 13:52:32 -0000 1.24
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: object-meths.t,v 1.23 2004/11/22 12:07:23 leo Exp $
+# $Id: object-meths.t,v 1.24 2004/11/22 13:52:32 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 23;
+use Parrot::Test tests => 24;
use Test::More;
output_like(<<'CODE', <<'OUTPUT', "callmethod - unknown method");
@@ -775,3 +775,38 @@
Key = foo
Key = foo
OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "Bug in method calling with nonconst keys -
clobber");
+##PIR##
+.sub _main
+ newclass $P0, "Foo"
+
+ find_type $I0, "Foo"
+ new $P1, $I0
+
+ $I1 = $P1["foo"]
+
+ $S0 = "foo"
+ $I1 = $P1[$S0]
+
+ end
+.end
+
+.namespace ["Foo"]
+
+.sub __get_integer_keyed
+ .param pmc key
+ $S0 = "bar"
+ print "Key = "
+ print key
+ print "\n"
+ print $S0
+ print "\n"
+ .return(0)
+.end
+CODE
+Key = foo
+bar
+Key = foo
+bar
+OUTPUT
