Opened 4 years ago

Last modified 4 years ago

#1298 new defect

Displaced arrays with invalid array dimension(s).

Reported by: markcox Owned by:
Priority: normal Milestone:
Component: ANSI CL Compliance Version: 1.10
Keywords: Cc:

Description

The function MAKE-ARRAY will return an array with invalid dimensions in cases where the value of displaced-index-offset plus the total size of the (invalid) displaced array dimensions is within the range 0 <= x <= (array-total-size target-array).

;; ccl64 --no-init --load issue.lisp ;; Welcome to Clozure Common Lisp Version 1.10-r16339 (DarwinX8664)! (let ((fn (lambda (displaced-dimensions dimensions offset)

(let ((array (make-array dimensions)))

(array-total-size (make-array displaced-dimensions

:displaced-to array :displaced-index-offset (+ (array-total-size array)

offset)))))))

;; Should signal an error but prints -1. (print (funcall fn -1 10 1)) ;; Should signal an error but prints -2. (print (funcall fn -2 10 1)) ;; Should signal an error but prints -1. (print (funcall fn -1 '(20 10) 1)) ;; Should signal an error but prints -10 (print (funcall fn '(5 -2) 10 1)) ;; Should signal an error but prints -15 (print (funcall fn '(5 -3) 10 15)))

Change History (1)

comment:1 Changed 4 years ago by markcox

I fixed the problem with the following patch.

$ svn diff level-1/l1-aprims.lisp 
Index: level-1/l1-aprims.lisp
===================================================================
--- level-1/l1-aprims.lisp	(revision 16488)
+++ level-1/l1-aprims.lisp	(working copy)
@@ -743,6 +743,12 @@
     (unless (and (fixnump offset) (>= (the fixnum offset) 0))
       (setq offset (require-type offset '(and fixnum (integer 0 *)))))
     (setq offset 0))
+  (if (listp dimensions)
+    (dolist (dim dimensions)
+      (unless (and (fixnump dim) (>= dim 0))
+        (error "Bad array dimensions ~s." dimensions)))
+    (unless (and (fixnump dimensions) (>= dimensions 0))
+      (error "Bad array dimensions ~s." dimensions)))
   (locally (declare (fixnum offset))
     (let* ((disp-size (array-total-size displaced-to))
            (rank (if (listp dimensions)(length dimensions) 1))

(My apologies for the formatting in the ticket.)

Note: See TracTickets for help on using tickets.