Skip to content
Snippets Groups Projects
Commit 5da45f2f authored by pfdietz's avatar pfdietz
Browse files

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

parent 67521a61
No related branches found
No related tags found
No related merge requests found
......@@ -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
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment