(import "test")
;;;
;;;  chapter14 Arrays
;;;

($ap 1 "Arrays")

($eval (defglobal array0 (create-array () 19)))
($eval (defglobal array2 #2a((0 1))))
($eval (defglobal array3 #3a(((0 1 2) (3 4 5)))))

;;;
;;; function (BASIC-ARRAY-P obj) --> boolean
;;;
($ap 2 "basic-array-p" P.91)
;;;
($argc basic-array-p 1 0 0)
($predicate basic-array-p $array $string $vector)

;;;
;;; function (BASIC-ARRAY*-P obj) --> boolean
;;;
($ap 2 "basic-array*-p" P.91)
;;;
($argc basic-array*-p 1 0 0)
($predicate basic-array*-p $array)

;;;
;;; function (GENERAL-ARRAY*-P obj) --> boolean
;;;
($ap 2 "general-array*-p" P.91)
($test (mapcar (lambda (x) (list (basic-array-p x) (basic-array*-p x) (general-array*-p x)))
         '((a b c) "abc" #(a b c) #1a(a b c) #2a((a) (b) (c))))
 ((nil nil nil ) (t nil nil ) (t nil nil) (t nil nil) (t t t))
 equal)
;;;
($argc general-array*-p 1 0 0)
($predicate general-array*-p $array)

;;;
;;; function (CREATE-ARRAY dimensions [initial-element]) --> <basic-array>
;;;
($ap 2 "create-array" P.92)
($test (create-array '(2 3) 0.0) #2a((0.0 0.0 0.0) (0.0 0.0 0.0)) equal)
($test (create-array '(2) 0.0) #(0.0 0.0) equal)
;;;
($argc create-array 1 1 0)
($type create-array ($cons $null) :target)
;;;
($test (basic-array*-p (create-array '() 'z)) t)
($test (create-array '(0) 'z) #1a() equal)
($test (create-array '(1) 'z) #1a(z) equal)
($test (create-array '(5) 'z) #1a(z z z z z) equal)
($test (basic-array*-p (create-array '(0 0) 'z)) t)
($test (basic-array*-p (create-array '(0 1) 'z)) t)
($test (create-array '(1 0) 'z) #2a(()) equal)
($test (create-array '(1 1) 'z) #2a((z)) equal)
($test (create-array '(1 5) 'z) #2a((z z z z z)) equal)
($test (create-array '(5 0) 'z) #2a(() () () () ()) equal)
($test (create-array '(5 1) 'z) #2a((z) (z) (z) (z) (z)) equal)
($test (create-array '(5 5) 'z) #2a((z z z z z) (z z z z z) (z z z z z) (z z z z z) (z z z z z)) equal)
($test (create-array '(1 2 3) 'z) #3a(((z z z) (z z z))) equal)
($error (create-array '(0.0)) <domain-error>)
($error (create-array '(-1)) <domain-error>)
($error (create-array '(-1234567890)) <domain-error>)
($error (create-array '(1234567890)) <storage-exhausted>)
($error (create-array '(0 0.0)) <domain-error>)
($error (create-array '(0 -1)) <domain-error>)
($error (create-array '(0 -1234567890)) <domain-error>)
($error (create-array '(0 1234567890)) <storage-exhausted>)

;;;
;;; function (AREF basic-array z*) --> <object>
;;;
($ap 2 "aref" P.92)
($eval (defglobal array1 (create-array '(3 3 3) 0)))
($test (list (aref array1 0 1 2)
       (setf (aref array1 0 1 2) 3.14)
       (aref array1 0 1 2))
 (0 3.14 3.14)
 equal)
($test (aref (create-array '(8 8) 6) 1 1) 6 eql)
($test (aref (create-array '() 19)) 19 eql)
;;;
($argc aref 1 0 1)
($type aref ($string $vector $array) :target)
($type aref ($integer) "abc" :target)
($type aref ($integer) #(a b c) :target)
($type aref ($integer) array2 :target 0)
($type aref ($integer) array2 0 :target)
($type aref ($integer) array3 :target 0 0)
($type aref ($integer) array3 0 0 :target)
;;; String
($error (aref "") <program-error>)
($error (aref "" 0 0) <program-error>)
($error (aref "" 0) <program-error>)
($test (aref "abc" 0) #\a eql)
($test (aref "abc" 2) #\c eql)
($error (aref "abc" -1) <domain-error>)
($error (aref "abc" -1234567890) <domain-error>)
($error (aref "abc" 3) <program-error>)
($error (aref "abc" 1234567890) <program-error>)
($test (aref (create-string 1000 #\a) 999) #\a eql)
;;; Vector
($error (aref #()) <program-error>)
($error (aref #() 0 0) <program-error>)
($error (aref #() 0) <program-error>)
($test (aref #(a b c) 0) a)
($test (aref #(a b c) 2) c)
($error (aref #(a b c) -1) <domain-error>)
($error (aref #(a b c) -1234567890) <domain-error>)
($error (aref #(a b c) 3) <program-error>)
($error (aref #(a b c) 1234567890) <program-error>)
($test (aref (create-vector 1000 19) 999) 19 eql)
;;; Array0
($test (aref array0) 19 eql)
($error (aref array0 0) <program-error>)
;;; Array2
($error (aref array2) <program-error>)
($error (aref array2 0) <program-error>)
($error (aref array2 0 0 0) <program-error>)
($test (aref array2 0 0) 0 eql)
($test (aref array2 0 1) 1 eql)
($error (aref array2 -1 0) <domain-error>)
($error (aref array2 -1234567890 0) <domain-error>)
($error (aref array2 1 0) <program-error>)
($error (aref array2 1234567890 0) <program-error>)
($error (aref array2 0 -1) <domain-error>)
($error (aref array2 0 -1234567890) <domain-error>)
($error (aref array2 0 2) <program-error>)
($error (aref array2 0 1234567890) <program-error>)
($test (aref (create-array '(1000 1000) 19) 999 999) 19 eql)
;;; Array3
($error (aref array3 0 0) <program-error>)
($error (aref array3 0 0 0 0) <program-error>)
($test (aref array3 0 0 0) 0 eql)
($test (aref array3 0 0 1) 1 eql)
($test (aref array3 0 0 2) 2 eql)
($test (aref array3 0 1 0) 3 eql)
($test (aref array3 0 1 1) 4 eql)
($test (aref array3 0 1 2) 5 eql)
($error (aref array3 -1 0 0) <domain-error>)
($error (aref array3 -1234567890 0 0) <domain-error>)
($error (aref array3 1 0 0) <program-error>)
($error (aref array3 1234567890 0 0) <program-error>)
($error (aref array3 0 0 -1) <domain-error>)
($error (aref array3 0 0 -1234567890) <domain-error>)
($error (aref array3 0 0 3) <program-error>)
($error (aref array3 0 0 1234567890) <program-error>)

;;;
;;; function (GAREF general-array z*) --> <object>
;;;
($ap 2 "garef" P.92)
;;;
($argc garef 1 0 1)
($type garef ($vector $array) :target)
($type garef ($integer) #(a b c) :target)
($type garef ($integer) array2 :target 0)
($type garef ($integer) array2 0 :target)
($type garef ($integer) array3 :target 0 0)
($type garef ($integer) array3 0 0 :target)
;;; Vector
($error (garef #()) <program-error>)
($error (garef #() 0 0) <program-error>)
($error (garef #() 0) <program-error>)
($test (garef #(a b c) 0) a)
($test (garef #(a b c) 2) c)
($error (garef #(a b c) -1) <domain-error>)
($error (garef #(a b c) -1234567890) <domain-error>)
($error (garef #(a b c) 3) <program-error>)
($error (garef #(a b c) 1234567890) <program-error>)
($test (garef (create-vector 1000 19) 999) 19 eql)
;;; Array0
($test (garef array0) 19 eql)
($error (garef array0 0) <program-error>)
;;; Array2
($error (garef array2) <program-error>)
($error (garef array2 0) <program-error>)
($error (garef array2 0 0 0) <program-error>)
($test (garef array2 0 0) 0 eql)
($test (garef array2 0 1) 1 eql)
($error (garef array2 -1 0) <domain-error>)
($error (garef array2 -1234567890 0) <domain-error>)
($error (garef array2 1 0) <program-error>)
($error (garef array2 1234567890 0) <program-error>)
($error (garef array2 0 -1) <domain-error>)
($error (garef array2 0 -1234567890) <domain-error>)
($error (garef array2 0 2) <program-error>)
($error (garef array2 0 1234567890) <program-error>)
($test (garef (create-array '(1000 1000) 19) 999 999) 19 eql)
;;; Array3
($error (garef array3 0 0) <program-error>)
($error (garef array3 0 0 0 0) <program-error>)
($test (garef array3 0 0 0) 0 eql)
($test (garef array3 0 0 1) 1 eql)
($test (garef array3 0 0 2) 2 eql)
($test (garef array3 0 1 0) 3 eql)
($test (garef array3 0 1 1) 4 eql)
($test (garef array3 0 1 2) 5 eql)
($error (garef array3 -1 0 0) <domain-error>)
($error (garef array3 -1234567890 0 0) <domain-error>)
($error (garef array3 1 0 0) <program-error>)
($error (garef array3 1234567890 0 0) <program-error>)
($error (garef array3 0 0 -1) <domain-error>)
($error (garef array3 0 0 -1234567890) <domain-error>)
($error (garef array3 0 0 3) <program-error>)
($error (garef array3 0 0 1234567890) <program-error>)

;;;
;;; function (SET-AREF obj basic-array z*) --> <object>
;;;
($ap 2 "set-aref" P.93)
($test (setf (aref array1 0 1 2) 3.15) 3.15 eql)
($test (set-aref 51.3 array1 0 1 2) 51.3 eql)
;;;
($argc set-aref 2 0 1)
($type set-aref ($string $vector $array) nil :target)
($type set-aref ($character) :target "abc" 0)
($type set-aref ($integer) #\b "abc" :target)
($type set-aref ($integer) nil #(a b c) :target)
($type set-aref ($integer) nil array2 :target 0)
($type set-aref ($integer) nil array2 0 :target)
($type set-aref ($integer) nil array3 :target 0 0)
($type set-aref ($integer) nil array3 0 0 :target)
;;; String
($error (setf (aref "") #\a) <program-error>)
($error (setf (aref "" 0 0) #\a) <program-error>)
($error (setf (aref "" 0) #\a) <program-error>)
($error (set-aref #\a "") <program-error>)
($error (set-aref #\a "" 0 0) <program-error>)
($error (set-aref #\a "" 0) <program-error>)
($test (let ((x "abc")) (list (setf (aref x 0) #\A) x)) (#\A "Abc") equal)
($test (let ((x "abc")) (list (setf (aref x 2) #\C) x)) (#\C "abC") equal)
($test (let ((x "abc")) (list (set-aref #\A x 0) x)) (#\A "Abc") equal)
($test (let ((x "abc")) (list (set-aref #\C x 2) x)) (#\C "abC") equal)
($error (setf (aref "abc" -1) #\a) <domain-error>)
($error (setf (aref "abc" -1234567890) #\a) <domain-error>)
($error (setf (aref "abc" 3) #\a) <program-error>)
($error (setf (aref "abc" 1234567890) #\a) <program-error>)
($error (set-aref #\a "abc" -1) <domain-error>)
($error (set-aref #\a "abc" -1234567890) <domain-error>)
($error (set-aref #\a "abc" 3) <program-error>)
($error (set-aref #\a "abc" 1234567890) <program-error>)
($test (let ((x (create-string 1000 #\a))) (list (setf (aref x 999) #\Z) (aref x 999)))
 (#\Z #\Z)
 equal)
($test (let ((x (create-string 1000 #\a))) (list (set-aref #\Z x 999) (aref x 999)))
 (#\Z #\Z)
 equal)
;;; Vector
($error (setf (aref #()) nil) <program-error>)
($error (setf (aref #() 0 0) nil) <program-error>)
($error (setf (aref #() 0) nil) <program-error>)
($error (set-aref nil #()) <program-error>)
($error (set-aref nil #() 0 0) <program-error>)
($error (set-aref nil #() 0) <program-error>)
($test (let ((x #(a b c))) (list (setf (aref x 0) 'z) x)) (z #(z b c)) equal)
($test (let ((x #(a b c))) (list (setf (aref x 2) 'z) x)) (z #(a b z)) equal)
($test (let ((x #(a b c))) (list (set-aref 'z x 0) x)) (z #(z b c)) equal)
($test (let ((x #(a b c))) (list (set-aref 'z x 2) x)) (z #(a b z)) equal)
($error (setf (aref #(a b c) -1) nil) <domain-error>)
($error (setf (aref #(a b c) -1234567890) nil) <domain-error>)
($error (setf (aref #(a b c) 3) nil) <program-error>)
($error (setf (aref #(a b c) 1234567890) nil) <program-error>)
($error (set-aref nil #(a b c) -1) <domain-error>)
($error (set-aref nil #(a b c) -1234567890) <domain-error>)
($error (set-aref nil #(a b c) 3) <program-error>)
($error (set-aref nil #(a b c) 1234567890) <program-error>)
($test (let ((x (create-vector 1000 'a))) (list (setf (aref x 999) 'z) (aref x 999)))
 (z z)
 equal)
($test (let ((x (create-vector 1000 'a))) (list (set-aref 'z x 999) (aref x 999)))
 (z z)
 equal)
;;; Array0
($test (let ((x (create-array () 'a))) (list (setf (aref x) 'z) (aref x)))
 (z z)
 equal)
($test (let ((x (create-array () 'a))) (list (set-aref 'z x) (aref x)))
 (z z)
 equal)
($error (setf (aref array0 0) nil) <program-error>)
($error (set-aref nil array0 0) <program-error>)
;;; Array2
($error (setf (aref array2) nil) <program-error>)
($error (setf (aref array2 0) nil) <program-error>)
($error (setf (aref array2 0 0 0) nil) <program-error>)
($error (set-aref nil array2) <program-error>)
($error (set-aref nil array2 0) <program-error>)
($error (set-aref nil array2 0 0 0) <program-error>)
($test (let ((x #2a((0 1)))) (list (setf (aref x 0 0) 9) x)) (9 #2a((9 1))) equal)
($test (let ((x #2a((0 1)))) (list (setf (aref x 0 1) 9) x)) (9 #2a((0 9))) equal)
($test (let ((x #2a((0 1)))) (list (set-aref 9 x 0 0) x)) (9 #2a((9 1))) equal)
($test (let ((x #2a((0 1)))) (list (set-aref 9 x 0 1) x)) (9 #2a((0 9))) equal)
($error (setf (aref array2 -1 0) nil) <domain-error>)
($error (setf (aref array2 -1234567890 0) nil) <domain-error>)
($error (setf (aref array2 1 0) nil) <program-error>)
($error (setf (aref array2 1234567890 0) nil) <program-error>)
($error (setf (aref array2 0 -1) nil) <domain-error>)
($error (setf (aref array2 0 -1234567890) nil) <domain-error>)
($error (setf (aref array2 0 2) nil) <program-error>)
($error (setf (aref array2 0 1234567890) nil) <program-error>)
($error (set-aref nil array2 -1 0) <domain-error>)
($error (set-aref nil array2 -1234567890 0) <domain-error>)
($error (set-aref nil array2 1 0) <program-error>)
($error (set-aref nil array2 1234567890 0) <program-error>)
($error (set-aref nil array2 0 -1) <domain-error>)
($error (set-aref nil array2 0 -1234567890) <domain-error>)
($error (set-aref nil array2 0 2) <program-error>)
($error (set-aref nil array2 0 1234567890) <program-error>)
($test (let ((x (create-array '(1000 1000) 'a)))
   (list (setf (aref x 999 999) 'z) (aref x 999 999)))
 (z z)
 equal)
($test (let ((x (create-array '(1000 1000) 'a)))
   (list (set-aref 'z x 999 999) (aref x 999 999)))
 (z z)
 equal)
;;; Array3
($error (setf (aref array3 0 0) nil) <program-error>)
($error (setf (aref array3 0 0 0 0) nil) <program-error>)
($error (set-aref nil array3 0 0) <program-error>)
($error (set-aref nil array3 0 0 0 0) <program-error>)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (aref x 0 0 0) 9) x))
 (9 #3a(((9 1 2) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (aref x 0 0 1) 9) x))
 (9 #3a(((0 9 2) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (aref x 0 0 2) 9) x))
 (9 #3a(((0 1 9) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (aref x 0 1 0) 9) x))
 (9 #3a(((0 1 2) (9 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (aref x 0 1 1) 9) x))
 (9 #3a(((0 1 2) (3 9 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (aref x 0 1 2) 9) x))
 (9 #3a(((0 1 2) (3 4 9))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-aref 9 x 0 0 0) x))
 (9 #3a(((9 1 2) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-aref 9 x 0 0 1) x))
 (9 #3a(((0 9 2) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-aref 9 x 0 0 2) x))
 (9 #3a(((0 1 9) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-aref 9 x 0 1 0) x))
 (9 #3a(((0 1 2) (9 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-aref 9 x 0 1 1) x))
 (9 #3a(((0 1 2) (3 9 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-aref 9 x 0 1 2) x))
 (9 #3a(((0 1 2) (3 4 9))))
 equal)
($error (setf (aref array3 -1 0 0) nil) <domain-error>)
($error (setf (aref array3 -1234567890 0 0) nil) <domain-error>)
($error (setf (aref array3 1 0 0) nil) <program-error>)
($error (setf (aref array3 1234567890 0 0) nil) <program-error>)
($error (setf (aref array3 0 0 -1) nil) <domain-error>)
($error (setf (aref array3 0 0 -1234567890) nil) <domain-error>)
($error (setf (aref array3 0 0 3) nil) <program-error>)
($error (setf (aref array3 0 0 1234567890) nil) <program-error>)
($error (set-aref nil array3 -1 0 0) <domain-error>)
($error (set-aref nil array3 -1234567890 0 0) <domain-error>)
($error (set-aref nil array3 1 0 0) <program-error>)
($error (set-aref nil array3 1234567890 0 0) <program-error>)
($error (set-aref nil array3 0 0 -1) <domain-error>)
($error (set-aref nil array3 0 0 -1234567890) <domain-error>)
($error (set-aref nil array3 0 0 3) <program-error>)
($error (set-aref nil array3 0 0 1234567890) <program-error>)

;;;
;;; function (SET-GAREF obj general-array z*) --> <object>
;;;
($ap 2 "set-garef" P.93)
;;;
($argc set-garef 2 0 1)
($type set-garef ($vector $array) nil :target)
($type set-garef ($integer) nil #(a b c) :target)
($type set-garef ($integer) nil array2 :target 0)
($type set-garef ($integer) nil array2 0 :target)
($type set-garef ($integer) nil array3 :target 0 0)
($type set-garef ($integer) nil array3 0 0 :target)
;;; Vector
($error (setf (garef #()) nil) <program-error>)
($error (setf (garef #() 0 0) nil) <program-error>)
($error (setf (garef #() 0) nil) <program-error>)
($error (set-garef nil #()) <program-error>)
($error (set-garef nil #() 0 0) <program-error>)
($error (set-garef nil #() 0) <program-error>)
($test (let ((x #(a b c))) (list (setf (garef x 0) 'z) x)) (z #(z b c)) equal)
($test (let ((x #(a b c))) (list (setf (garef x 2) 'z) x)) (z #(a b z)) equal)
($test (let ((x #(a b c))) (list (set-garef 'z x 0) x)) (z #(z b c)) equal)
($test (let ((x #(a b c))) (list (set-garef 'z x 2) x)) (z #(a b z)) equal)
($error (setf (garef #(a b c) -1) nil) <domain-error>)
($error (setf (garef #(a b c) -1234567890) nil) <domain-error>)
($error (setf (garef #(a b c) 3) nil) <program-error>)
($error (setf (garef #(a b c) 1234567890) nil) <program-error>)
($error (set-garef nil #(a b c) -1) <domain-error>)
($error (set-garef nil #(a b c) -1234567890) <domain-error>)
($error (set-garef nil #(a b c) 3) <program-error>)
($error (set-garef nil #(a b c) 1234567890) <program-error>)
($test (let ((x (create-vector 1000 'a))) (list (setf (garef x 999) 'z) (garef x 999)))
 (z z)
 equal)
($test (let ((x (create-vector 1000 'a))) (list (set-garef 'z x 999) (garef x 999)))
 (z z)
 equal)
;;; Array0
($test (let ((x (create-array () 'a))) (list (setf (garef x) 'z) (garef x)))
 (z z)
 equal)
($test (let ((x (create-array () 'a))) (list (set-garef 'z x) (garef x)))
 (z z)
 equal)
($error (setf (garef array0 0) nil) <program-error>)
($error (set-garef nil array0 0) <program-error>)
;;; Array2
($error (setf (garef array2) nil) <program-error>)
($error (setf (garef array2 0) nil) <program-error>)
($error (setf (garef array2 0 0 0) nil) <program-error>)
($error (set-garef nil array2) <program-error>)
($error (set-garef nil array2 0) <program-error>)
($error (set-garef nil array2 0 0 0) <program-error>)
($test (let ((x #2a((0 1)))) (list (setf (garef x 0 0) 9) x)) (9 #2a((9 1))) equal)
($test (let ((x #2a((0 1)))) (list (setf (garef x 0 1) 9) x)) (9 #2a((0 9))) equal)
($test (let ((x #2a((0 1)))) (list (set-garef 9 x 0 0) x)) (9 #2a((9 1))) equal)
($test (let ((x #2a((0 1)))) (list (set-garef 9 x 0 1) x)) (9 #2a((0 9))) equal)
($error (setf (garef array2 -1 0) nil) <domain-error>)
($error (setf (garef array2 -1234567890 0) nil) <domain-error>)
($error (setf (garef array2 1 0) nil) <program-error>)
($error (setf (garef array2 1234567890 0) nil) <program-error>)
($error (setf (garef array2 0 -1) nil) <domain-error>)
($error (setf (garef array2 0 -1234567890) nil) <domain-error>)
($error (setf (garef array2 0 2) nil) <program-error>)
($error (setf (garef array2 0 1234567890) nil) <program-error>)
($error (set-garef nil array2 -1 0) <domain-error>)
($error (set-garef nil array2 -1234567890 0) <domain-error>)
($error (set-garef nil array2 1 0) <program-error>)
($error (set-garef nil array2 1234567890 0) <program-error>)
($error (set-garef nil array2 0 -1) <domain-error>)
($error (set-garef nil array2 0 -1234567890) <domain-error>)
($error (set-garef nil array2 0 2) <program-error>)
($error (set-garef nil array2 0 1234567890) <program-error>)
($test (let ((x (create-array '(1000 1000) 'a)))
   (list (setf (garef x 999 999) 'z) (garef x 999 999)))
 (z z)
 equal)
($test (let ((x (create-array '(1000 1000) 'a)))
   (list (set-garef 'z x 999 999) (garef x 999 999)))
 (z z)
 equal)
;;; Array3
($error (setf (garef array3 0 0) nil) <program-error>)
($error (setf (garef array3 0 0 0 0) nil) <program-error>)
($error (set-garef nil array3 0 0) <program-error>)
($error (set-garef nil array3 0 0 0 0) <program-error>)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (garef x 0 0 0) 9) x))
 (9 #3a(((9 1 2) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (garef x 0 0 1) 9) x))
 (9 #3a(((0 9 2) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (garef x 0 0 2) 9) x))
 (9 #3a(((0 1 9) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (garef x 0 1 0) 9) x))
 (9 #3a(((0 1 2) (9 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (garef x 0 1 1) 9) x))
 (9 #3a(((0 1 2) (3 9 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (setf (garef x 0 1 2) 9) x))
 (9 #3a(((0 1 2) (3 4 9))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-garef 9 x 0 0 0) x))
 (9 #3a(((9 1 2) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-garef 9 x 0 0 1) x))
 (9 #3a(((0 9 2) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-garef 9 x 0 0 2) x))
 (9 #3a(((0 1 9) (3 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-garef 9 x 0 1 0) x))
 (9 #3a(((0 1 2) (9 4 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-garef 9 x 0 1 1) x))
 (9 #3a(((0 1 2) (3 9 5))))
 equal)
($test (let ((x #3a(((0 1 2) (3 4 5))))) (list (set-garef 9 x 0 1 2) x))
 (9 #3a(((0 1 2) (3 4 9))))
 equal)
($error (setf (garef array3 -1 0 0) nil) <domain-error>)
($error (setf (garef array3 -1234567890 0 0) nil) <domain-error>)
($error (setf (garef array3 1 0 0) nil) <program-error>)
($error (setf (garef array3 1234567890 0 0) nil) <program-error>)
($error (setf (garef array3 0 0 -1) nil) <domain-error>)
($error (setf (garef array3 0 0 -1234567890) nil) <domain-error>)
($error (setf (garef array3 0 0 3) nil) <program-error>)
($error (setf (garef array3 0 0 1234567890) nil) <program-error>)
($error (set-garef nil array3 -1 0 0) <domain-error>)
($error (set-garef nil array3 -1234567890 0 0) <domain-error>)
($error (set-garef nil array3 1 0 0) <program-error>)
($error (set-garef nil array3 1234567890 0 0) <program-error>)
($error (set-garef nil array3 0 0 -1) <domain-error>)
($error (set-garef nil array3 0 0 -1234567890) <domain-error>)
($error (set-garef nil array3 0 0 3) <program-error>)
($error (set-garef nil array3 0 0 1234567890) <program-error>)

;;;
;;; function (ARRAY-DIMENSIONS basic-array) --> <list>
;;;
($ap 2 "array-dimensions" P.93)
($test (array-dimensions (create-array '(2 2) 0)) (2 2) equal)
($test (array-dimensions (vector 'a 'b)) (2) equal)
($test (array-dimensions "foo") (3) equal)
;;;
($argc array-dimensions 1 0 0)
($type array-dimensions ($string $vector $array) :target)
;;;
($test (array-dimensions array0) ())
($test (array-dimensions "") (0) equal)
($test (array-dimensions (create-string 1000)) (1000) equal)
($test (array-dimensions #()) (0) equal)
($test (array-dimensions (create-vector 1000)) (1000) equal)
($test (array-dimensions array2) (1 2) equal)
($test (array-dimensions (create-array '(1000 1000))) (1000 1000) equal)
($test (array-dimensions array3) (1 2 3) equal)
($test (array-dimensions (create-array '(100 100 100))) (100 100 100) equal)

