(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL-USER")

(il:filecreated "17-Jun-88 17:28:36" il:{qv}<pedersen>lisp>aref-tester.\;4
 4689   

      il:|changes| il:|to:|  (verified-tests aref1-punt aref1-signed-word aref1-displaced aref1-bit aref1-byte aref1-word aref1-fixp aref1-floatp aref1-string-char aref1-pointer aref1-xpointer)
 (il:vars il:aref-testercoms) (file-environments "AREF-TESTER")

      il:|previous| il:|date:| "17-Jun-88 12:03:57" il:{qv}<pedersen>lisp>aref-tester.\;1)


; Copyright (c) 1988 by Xerox Corporation.  All rights reserved.

(il:prettycomprint il:aref-testercoms)

(il:rpaqq il:aref-testercoms ((il:files il:tester) (il:coms (il:* il:|;;| "AREF1 all types") (verified-tests aref1-bit aref1-byte aref1-word aref1-signed-word aref1-fixp aref1-floatp aref1-string-char aref1-pointer aref1-xpointer aref1-punt)) (file-environments "AREF-TESTER")))

(il:filesload il:tester)



(il:* il:|;;| "AREF1 all types")



(define-verified-test aref1-bit "Opcode aref1, type (unsigned-byte 1)" (let* ((array-1 (make-array 4 :element-type (quote (unsigned-byte 1)) :initial-contents (quote (0 1 0 1)))) (array-2 (make-array 4 :element-type (quote (unsigned-byte 1)) :displaced-to array-1))) (with-collection (dotimes (i 4) (collect (aref array-1 i)) (collect (aref array-2 i))))))

(define-verified-test aref1-byte "Opcode aref1, type (unsigned-byte 8)" (let* ((array-1 (make-array 5 :element-type (quote (unsigned-byte 8)) :initial-contents (quote (0 34 56 255 23)))) (array-2 (make-array 5 :element-type (quote (unsigned-byte 8)) :displaced-to array-1))) (with-collection (dotimes (i 5) (collect (aref array-1 i)) (collect (aref array-2 i))))))

(define-verified-test aref1-word "Opcode aref1, type (unsigned-byte 16)" (let* ((array-1 (make-array 5 :element-type (quote (unsigned-byte 16)) :initial-contents (quote (0 34 255 65535 23)))) (array-2 (make-array 5 :element-type (quote (unsigned-byte 16)) :displaced-to array-1))) (with-collection (dotimes (i 5) (collect (aref array-1 i)) (collect (aref array-2 i))))))

(define-verified-test aref1-signed-word "Opcode aref1, type (signed-byte 16)" (let ((array (make-array 5 :element-type (quote (signed-byte 16)) :initial-contents (quote (0 -34 255 -32768 23))))) (with-collection (dotimes (i 5) (collect (aref array i))))))

(define-verified-test aref1-fixp "Opcode aref1, type (signed-byte 32)" (let ((array (make-array 5 :element-type (quote (signed-byte 32)) :initial-contents (quote (0 -34 258 -65538 2147483647))))) (with-collection (dotimes (i 5) (collect (aref array i))))))

(define-verified-test aref1-floatp "Opcode aref1, type single-float" (let ((array (make-array 5 :element-type (quote single-float) :initial-contents (quote (0.0 -34.0 3.456756E+35 -5.768E-34 5.4524))))) (with-collection (dotimes (i 5) (collect (aref array i))))))

(define-verified-test aref1-string-char "Opcode aref1, type string-char" (let ((array-1 (make-array 3 :element-type (quote string-char) :initial-contents (quote (#\Space #\a #\b)))) (array-2 (make-array 3 :element-type (quote string-char) :fatp t :initial-contents (quote (#\Space #\Greek-0 #\Greek-32))))) (with-collection (dotimes (i 3) (collect (aref array-1 i)) (collect (aref array-2 i))))))

(define-verified-test aref1-pointer "Opcode aref1, type t" (let* ((lst (list 0 (cons (quote a) (quote b)) 3.4 (quote c) (cons (quote d) (quote e)))) (array (make-array 5 :element-type t :initial-contents lst))) (with-collection (dotimes (i 5) (collect (cons (aref array i) (il:\\refcnt (aref array i))))))))

(define-verified-test aref1-xpointer "Opcode aref1, type il:xpointer" (let* ((lst (list 0 (cons (quote a) (quote b)) 3.4 (quote c) (cons (quote d) (quote e)))) (array (make-array 5 :element-type (quote il:xpointer) :initial-contents lst))) (with-collection (dotimes (i 5) (collect (cons (aref array i) (il:\\refcnt (aref array i))))))))

(define-verified-test aref1-punt "Opcode aref1, punt cases" (let* ((array-1 (make-array 4 :element-type (quote string-char) :displaced-to (make-array 4 :element-type (quote string-char) :initial-contents (quote (#\a #\b #\c #\d))))) (array-2 (make-array 4 :element-type t :adjustable t :initial-contents (quote (0 a b (a . b))))) (array-3 (make-array 4 :element-type (quote (unsigned-byte 8)) :read-only-p t :initial-contents (quote (0 1 2 3))))) (il:* il:|;;| "aref1 should punt on all these cases") (with-collection (dotimes (i 4) (collect (aref array-1 i)) (collect (aref array-2 i)) (collect (aref array-3 i))))))

(define-file-environment "AREF-TESTER" :package "XCL-USER" :readtable "XCL" :compiler :compile-file)
(il:putprops il:aref-tester il:copyright ("Xerox Corporation" 1988))
(il:declare\: il:dontcopy
  (il:filemap (nil)))
il:stop