cvsuser 03/08/08 08:04:14
Modified: classes array.pmc pmc2c.pl
t/pmc array.t
Log:
fix Array_set_pmc_keyed with multikeys
Revision Changes Path
1.59 +17 -4 parrot/classes/array.pmc
Index: array.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/array.pmc,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -w -r1.58 -r1.59
--- array.pmc 7 Aug 2003 18:44:06 -0000 1.58
+++ array.pmc 8 Aug 2003 15:04:10 -0000 1.59
@@ -1,7 +1,7 @@
/* array.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: array.pmc,v 1.58 2003/08/07 18:44:06 scog Exp $
+ * $Id: array.pmc,v 1.59 2003/08/08 15:04:10 leo Exp $
* Overview:
* These are the vtable functions for the Array base class
* Data Structure and Algorithms:
@@ -335,9 +335,22 @@
(void*)src, enum_type_PMC);
}
- void set_pmc_keyed (PMC* key, PMC* src) {
- INTVAL idx = key_integer(INTERP, key);
- SELF.set_pmc_keyed_int(idx, src);
+ void set_pmc_keyed (PMC* key, PMC* value) {
+ INTVAL ix = key_integer(INTERP, key);
+ PMC* nextkey;
+ PMC* box;
+
+ nextkey = key_next(INTERP, key);
+ if (nextkey == NULL) {
+ VTABLE_set_pmc_keyed_int(INTERP, SELF, ix, value);
+ return;
+ }
+ box = SELF.get_pmc_keyed_int(ix);
+ if (box == NULL) {
+ /* autovivify an Array */
+ box = pmc_new(INTERP, DYNSELF.type());
+ }
+ VTABLE_set_pmc_keyed(INTERP, box, nextkey, value);
}
void push_integer (INTVAL value) {
1.29 +2 -1 parrot/classes/pmc2c.pl
Index: pmc2c.pl
===================================================================
RCS file: /cvs/public/parrot/classes/pmc2c.pl,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -w -r1.28 -r1.29
--- pmc2c.pl 8 Aug 2003 08:15:14 -0000 1.28
+++ pmc2c.pl 8 Aug 2003 15:04:10 -0000 1.29
@@ -508,9 +508,10 @@
# add the actual code for the .c file
my $decl = "$type Parrot_${classname}_${methodname} (struct Parrot_Interp
*interpreter, PMC* pmc$parameters)";
$HOUT .= "extern $decl;\n";
+ my $lcor = $lineno + 4; # line directive correction
$methodbody{ $methodname } =
- ( $suppress_lines ? '' : "\n#line $lineno \"$pmcfile\"\n " ) .
+ ( $suppress_lines ? '' : "\n#line $lcor \"$pmcfile\"\n " ) .
$decl .
$methodblock;
1.15 +59 -3 parrot/t/pmc/array.t
Index: array.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/array.t,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- array.t 5 May 2003 16:47:00 -0000 1.14
+++ array.t 8 Aug 2003 15:04:13 -0000 1.15
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 9;
+use Parrot::Test tests => 11;
use Test::More;
my $fp_equality_macro = <<'ENDOFMACRO';
@@ -343,4 +343,60 @@
ok 4
OUTPUT
+output_is(<<'CODE', <<OUT, "multikeyed access I arg");
+ new P0, .Array
+ set P0, 1
+ new P1, .Array
+ set P1, 1
+ set P0[0], P1
+ set P0[0;0], 20
+ set P2, P0[0]
+ typeof S0, P2
+ print S0
+ print "\n"
+ set I2, P0[0;0]
+ print I2
+ set I3, 0
+ set I2, P0[I3;0]
+ print I2
+ set I2, P0[0;I3]
+ print I2
+ set I2, P0[I3;I3]
+ print I2
+ print "\n"
+ end
+CODE
+Array
+20202020
+OUT
+
+output_is(<<'CODE', <<OUT, "multikeyed access P arg");
+ new P0, .Array
+ set P0, 1
+ new P1, .Array
+ set P1, 1
+ new P3, .PerlInt
+ set P3, 20
+ set P0[0], P1
+ set P0[0;0], P3
+ set P2, P0[0]
+ typeof S0, P2
+ print S0
+ print "\n"
+ set I2, P0[0;0]
+ print I2
+ set I3, 0
+ set I2, P0[I3;0]
+ print I2
+ set I2, P0[0;I3]
+ print I2
+ set I2, P0[I3;I3]
+ print I2
+ print "\n"
+ end
+CODE
+Array
+20202020
+OUT
+1;
1;
