# New Ticket Created by "Sean O'Rourke"
# Please include the string: [perl #17070]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=17070 >
Perl arrays allow accesses to negative out-of-bounds indices without
complaining or resizing. This changes perlarray.pmc to do this, with
tests.
/s
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/36885/29740/ebba9b/pa.patch
Index: t/pmc/perlarray.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlarray.t,v
retrieving revision 1.19
diff -p -u -w -r1.19 perlarray.t
--- t/pmc/perlarray.t 19 Aug 2002 23:17:57 -0000 1.19
+++ t/pmc/perlarray.t 8 Sep 2002 06:44:38 -0000
@@ -238,6 +238,23 @@ OK_18: print "ok 18\n"
print "not "
OK_19: print "ok 19\n"
+# Out-of-bounds accesses:
+ set I0, P0
+ set I2, P0[10]
+ eq I2, 0, OK_20
+ print "not "
+OK_20: print "ok 20\n"
+
+ set I2, P0[-10]
+ eq I2, 0, OK_21
+ print "not "
+OK_21: print "ok 21\n"
+
+# Make sure it hasn't resized the array:
+ set I2, P0
+ eq I2, I0, OK_22
+ print "not "
+OK_22: print "ok 22\n"
end
CODE
ok 1
@@ -259,6 +276,9 @@ ok 16
ok 17
ok 18
ok 19
+ok 20
+ok 21
+ok 22
OUTPUT
output_is(<<'CODE', <<'OUTPUT', "Bracketed access test suite");
Index: classes/perlarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlarray.pmc,v
retrieving revision 1.43
diff -p -u -w -r1.43 perlarray.pmc
--- classes/perlarray.pmc 19 Aug 2002 23:15:20 -0000 1.43
+++ classes/perlarray.pmc 8 Sep 2002 06:44:38 -0000
@@ -175,7 +175,7 @@ pmclass PerlArray extends Array {
};
INTVAL get_integer_keyed_int (INTVAL* key) {
- if (*key >= SELF->cache.int_val) {
+ if (*key >= SELF->cache.int_val || *key < -SELF->cache.int_val) {
PMC* temp = undef(INTERP);
return temp->vtable->get_integer(INTERP, temp);
}
@@ -199,7 +199,7 @@ pmclass PerlArray extends Array {
}
FLOATVAL get_number_keyed_int (INTVAL* key) {
- if (*key >= SELF->cache.int_val) {
+ if (*key >= SELF->cache.int_val || *key < -SELF->cache.int_val) {
PMC* temp = undef(INTERP);
return temp->vtable->get_number(INTERP, temp);
}
@@ -222,6 +222,10 @@ pmclass PerlArray extends Array {
return box->vtable->get_number_keyed(INTERP, box, nextkey);
}
+ STRING* get_string () {
+ return string_from_int(INTERP, SELF->cache.int_val);
+ }
+
STRING* get_string_keyed_int (INTVAL* key) {
if (*key >= SELF->cache.int_val) {
PMC* value = undef(INTERP);
@@ -247,7 +251,7 @@ pmclass PerlArray extends Array {
}
PMC* get_pmc_keyed_int (INTVAL* key) {
- if (*key >= SELF->cache.int_val)
+ if (*key >= SELF->cache.int_val || *key < -SELF->cache.int_val)
return undef(INTERP);
else
return SUPER(key);