# 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);

Reply via email to