Commit 5da45f2f authored by pfdietz's avatar pfdietz

Added the correct tests for TYPECASE, and some tests for AREF.

parent 67521a61
......@@ -1374,3 +1374,5 @@ the condition to go uncaught if it cannot be classified."
(defun with-package-iterator-all (packages)
(test-with-package-iterator packages :internal :external :inherited))
(deftype otherwise () nil) ;; used in testing TYPECASE
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Tue Feb 11 17:33:24 2003
;;;; Contains: Tests for AREF
(in-package :cl-test)
;;; AREF is also tested in many other places
(deftest aref.1
(aref #0aT)
T)
(deftest aref.2
(aref #(1 2 3 4) 2)
3)
(deftest aref.3
(aref #2a((a b c d)(e f g h)) 1 2)
g)
(deftest aref.4
(loop for i from 0 below 6 collect (aref "abcdef" i))
(#\a #\b #\c #\d #\e #\f))
(deftest aref.5
(let ((a (make-array '(2 3) :element-type 'base-char
:initial-contents '("abc" "def"))))
(loop for i below 2
collect (loop for j below 3
collect (aref a i j))))
((#\a #\b #\c)
(#\d #\e #\f)))
(deftest aref.6
(loop for i below 10 collect (aref #*1101100010 i))
(1 1 0 1 1 0 0 0 1 0))
(deftest aref.7
(let ((a (make-array '(2 5) :element-type 'bit
:initial-contents '((1 1 0 0 1)
(0 1 0 1 0)))))
(loop for i below 2
collect (loop for j below 5
collect (aref a i j))))
((1 1 0 0 1)
(0 1 0 1 0)))
;;; Order of argument evaluation
(deftest aref.8
(let ((i 0) x y (a #(a b c d)))
(values
(aref (progn (setf x (incf i)) a)
(progn (setf y (incf i)) 2))
i x y))
c 2 1 2)
(deftest aref.9
(let ((i 0) x y z (a #2a((a b c)(d e f))))
(values
(aref (progn (setf x (incf i)) a)
(progn (setf y (incf i)) 1)
(progn (setf z (incf i)) 2))
i x y z))
f 3 1 2 3)
;;; Setf of aref
(deftest setf-aref.1
(let ((a (copy-seq #(1 2 3 4))))
(values
(setf (aref a 2) 'z)
a))
z
#(1 2 z 4))
(deftest setf-aref.2
(let ((a (make-array nil :initial-element 1)))
(values
(setf (aref a) 'z)
a))
z #0az)
(deftest setf-aref.3
(let ((a (make-array '(2 3) :initial-element 'a)))
(values
(setf (aref a 0 1) 'z)
a))
z
#2a((a z a)(a a a)))
(deftest setf-aref.4
(let ((a (copy-seq "abcd")))
(values
(setf (aref a 0) #\z)
a))
#\z
"zbcd")
(deftest setf-aref.5
(let ((a (copy-seq #*0011)))
(values
(setf (aref a 0) 1)
a))
1
#*1011)
(deftest setf-aref.6
(let ((a (make-array '(2 3) :initial-element #\a :element-type 'base-char)))
(values
(setf (aref a 0 1) #\z)
a))
#\z
#2a((#\a #\z #\a)(#\a #\a #\a)))
(deftest setf-aref.7
(let ((a (make-array '(2 3) :initial-element 1 :element-type 'bit)))
(values
(setf (aref a 0 1) 0)
a))
0
#2a((1 0 1)(1 1 1)))
(deftest setf-aref.8
(let ((i 0) x y z (a (copy-seq #(a b c d))))
(values
(setf (aref (progn (setf x (incf i)) a)
(progn (setf y (incf i)) 2))
(progn (setf z (incf i)) 'z))
a
i x y z))
z #(a b z d) 3 1 2 3)
;;; To add: aref on displaced arrays, arrays with fill pointers, etc.
(deftest aref.error.1
(classify-error (aref))
program-error)
(deftest aref.error.2
(classify-error (funcall #'aref))
program-error)
......@@ -140,6 +140,7 @@
;;; Tests on arrays
(compile-and-load "array-aux.lsp")
(load "aref.lsp")
(load "array.lsp")
(load "array-t.lsp")
(load "array-as-class.lsp")
......
......@@ -64,3 +64,13 @@
(deftest typecase.14
(typecase 1 (symbol 'a) (otherwise))
nil)
;;; (deftype otherwise () nil)
(deftest typecase.15
(typecase 'foo (otherwise :wrong) (t :right))
:right)
(deftest typecase.16
(typecase 'foo (otherwise :wrong) (symbol :right) (t :wrong2))
:right)
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment