Commit 2543e760 authored by pfdietz's avatar pfdietz

Moved some tests over from the cases-14-1-* files (which have been removed).

parent a9fc854e
......@@ -11,6 +11,31 @@
(defun make-int-list (n)
(loop for i from 0 to (1- n) collect i))
(defun make-int-array (n &optional (fn #'make-array))
(let ((a (funcall fn n)))
(loop
for i from 0 to (1- n) do
(setf (aref a i) i))
a))
(defun equal-array (a1 a2)
(and (typep a1 'array)
(typep a2 'array)
(= (array-rank a1) (array-rank a2))
(let ((ad (array-dimensions a1)))
(and (equal ad (array-dimensions a2))
(if (= (array-rank a1) 1)
(let ((as (first ad)))
(loop
for i from 0 to (1- as)
always (equal (aref a1 i) (aref a2 i))))
(let ((as (array-total-size a1)))
(and (= as (array-total-size a2))
(loop
for i from 0 to (1- as)
always (equal (row-major-aref a1 i)
(row-major-aref a2 i))))))))))
(declaim (special *universe*))
(defun check-type-predicate (P TYPE)
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Wed Apr 8 20:05:24 1998
;;;; Contains: Test cases for CL, section 14.1 of CLtL2, Lists as Sequences
;;;; Created: Sat Oct 12 19:38:29 2002
;;;; Contains: Tests of ELT
(in-package :cl-test)
(use-package :rt)
(declaim (optimize (safety 3)))
......@@ -115,208 +114,205 @@
(safe-elt x #\w))
type-error)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; subseq, on lists
(deftest subseq-list-1
(subseq '(a b c d e) 0 0)
nil)
(deftest subseq-list-2
(subseq '(a b c) 0)
(a b c))
(deftest subseq-list-3
(subseq '(a b c) 1)
(b c))
(defun subseq-list-4-body ()
(block done
(let ((x (loop for i from 0 to 19 collect i)))
(loop
for i from 0 to 20 do
(loop
for j from i to 20 do
(let ((y (subseq x i j)))
(loop
for e in y and k from i to (1- j) do
(unless (eql e k) (return-from done nil)))))))
t))
(deftest subseq-list-4
(subseq-list-4-body)
t)
(defun subseq-list-5-body ()
(block done
(let ((x (loop for i from 0 to 29 collect i)))
(loop
for i from 0 to 30 do
(unless (equal (subseq x i)
(loop for j from i to 29 collect j))
(return-from done nil))))
t))
(deftest subseq-list-5
(subseq-list-5-body)
t)
(deftest elt-v-1
(handler-case
(elt (make-array '(0)) 0)
(type-error () 'type-error)
(error (c) c))
type-error)
(defun subseq-list-6-body ()
;; (deftest elt-v-2 (elt (make-array '(1)) 0) nil) ;; actually undefined
(deftest elt-v-3 (elt (make-array '(5) :initial-contents '(a b c d e)) 0)
a)
(deftest elt-v-4 (elt (make-array '(5) :initial-contents '(a b c d e)) 2)
c)
(deftest elt-v-5 (elt (make-array '(5) :initial-contents '(a b c d e)) 4)
e)
(let* ((x (make-list 100))
(z (loop for e on x collect e))
(y (subseq x 0)))
(defun elt-v-6-body ()
(let ((x (make-int-list 1000)))
(let ((a (make-array '(1000) :initial-contents x)))
(loop
for e on x
and f on y
and g in z do
(when (or (not (eq g e))
(not (eql (car e) (car f)))
(car e)
(eq e f))
(return nil))
finally (return t))))
(deftest subseq-list-6 ;; check that no structure is shared
(subseq-list-6-body)
for i from 0 to 999 do
(unless (eql i (elt a i)) (return nil))
finally (return t)))))
(deftest elt-v-6
(elt-v-6-body)
t)
(deftest subseq-list-7
(let ((x (loop for i from 0 to 9 collect i)))
(setf (subseq x 0 3) (list 'a 'b 'c))
x)
(a b c 3 4 5 6 7 8 9))
(deftest subseq-list-8
(let* ((x '(a b c d e))
(y (copy-seq x)))
(setf (subseq y 0) '(f g h))
(list x y))
((a b c d e) (f g h d e)))
(deftest subseq-list-9
(let* ((x '(a b c d e))
(y (copy-seq x)))
(setf (subseq y 1 3) '(1 2 3 4 5))
(list x y))
((a b c d e) (a 1 2 d e)))
(deftest subseq-list-10
(let* ((x '(a b c d e))
(y (copy-seq x)))
(setf (subseq y 5) '(1 2 3 4 5))
(list x y))
((a b c d e) (a b c d e)))
(deftest subseq-list-11
(let* ((x '(a b c d e))
(y (copy-seq x)))
(setf (subseq y 2 5) '(1))
(list x y))
((a b c d e) (a b 1 d e)))
(deftest subseq-list-12
(let* ((x '(a b c d e))
(y (copy-seq x)))
(setf (subseq y 0 0) '(1 2))
(list x y))
((a b c d e) (a b c d e)))
;; length of lists
(deftest length-list-1
(length ())
0)
(deftest length-list-2
(length '(a b c d e f g))
7)
(deftest length-list-3
(length (make-list 200000))
200000)
(defun length-list-4-body ()
(let ((x ()))
(deftest elt-v-7
(let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))
(y (setf (elt x 0) 'e)))
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
(e b c d e))
(deftest elt-v-8
(let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))
(y (setf (elt x 1) 'e)))
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
(a e c d e))
(deftest elt-v-9
(let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))
(y (setf (elt x 3) 'e)))
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
(a b c e e))
(deftest elt-v-10
(handler-case
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c))))
(setf (elt x 4) 'd))
(type-error () 'type-error)
(error (c) c))
type-error)
(deftest elt-v-11
(handler-case
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c))))
(setf (elt x -100) 'd))
(type-error () 'type-error)
(error (c) c))
type-error)
(deftest elt-v-12
(let ((x (make-int-array 100000)))
(elt x 90000))
90000)
(deftest elt-v-13
(let ((x (make-int-array 100000)))
(setf (elt x 80000) 'foo)
(list (elt x 79999)
(elt x 80000)
(elt x 80001)))
(79999 foo 80001))
;;; Adjustable arrays
(defun make-adj-array (n &key initial-contents)
(if initial-contents
(make-array n :adjustable t :initial-contents initial-contents)
(make-array n :adjustable t)))
(deftest elt-adj-array-1
(handler-case
(elt (make-adj-array '(0)) 0)
(type-error () 'type-error)
(error (c) c))
type-error)
;;; (deftest elt-adj-array-2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined
(deftest elt-adj-array-3
(elt (make-adj-array '(5) :initial-contents '(a b c d e)) 0)
a)
(deftest elt-adj-array-4
(elt (make-adj-array '(5) :initial-contents '(a b c d e)) 2)
c)
(deftest elt-adj-array-5
(elt (make-adj-array '(5) :initial-contents '(a b c d e)) 4)
e)
(defun elt-adj-array-6-body ()
(let ((x (make-int-list 1000)))
(let ((a (make-adj-array '(1000) :initial-contents x)))
(loop
for i from 0 to 999 do
(progn
(unless (eql (length x) i) (return nil))
(push i x))
finally (return t))))
(unless (eql i (elt a i)) (return nil))
finally (return t)))))
(deftest length-list-4
(length-list-4-body)
(deftest elt-adj-array-6
(elt-adj-array-6-body)
t)
;; reverse of lists
(deftest reverse-list-1
(reverse ())
())
(deftest reverse-list-2
(reverse '(a b c d e f))
(f e d c b a))
(defun reverse-list-3-body ()
(let* ((x (loop for i from 0 to 999 collect i))
(z (loop for e on x collect e))
(y (reverse x)))
(and
(loop
for e on x and f in z do
(unless (eq e f) (return nil))
finally (return t))
(every #'eql
y
(loop for i from 999 downto 0 collect i)))))
(deftest reverse-list-3
(reverse-list-3-body)
t)
(deftest elt-adj-array-7
(let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))
(y (setf (elt x 0) 'e)))
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
(e b c d e))
(deftest nreverse-list-1
(nreverse nil)
nil)
(deftest elt-adj-array-8
(let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))
(y (setf (elt x 1) 'e)))
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
(a e c d e))
(deftest nreverse-list-2
(nreverse (list 'a))
(a))
(deftest elt-adj-array-9
(let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))
(y (setf (elt x 3) 'e)))
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
(a b c e e))
(deftest nreverse-list-3
(nreverse (list 'a 'b 'c 'd))
(d c b a))
(deftest elt-adj-array-10
(handler-case
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c))))
(setf (elt x 4) 'd))
(type-error () 'type-error)
(error (c) c))
type-error)
(deftest elt-adj-array-11
(handler-case
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c))))
(setf (elt x -100) 'd))
(type-error () 'type-error)
(error (c) c))
type-error)
(defun nreverse-list-4-body ()
(let* ((x (loop for i from 0 to 100000 collect i))
(y (copy-seq x)))
(equal y (nreverse (nreverse x)))))
(deftest elt-adj-array-12
(let ((x (make-int-array 100000 #'make-adj-array)))
(elt x 90000))
90000)
(deftest nreverse-list-4
(nreverse-list-4-body)
t)
(deftest elt-adj-array-13
(let ((x (make-int-array 100000 #'make-adj-array)))
(setf (elt x 80000) 'foo)
(list (elt x 79999)
(elt x 80000)
(elt x 80001)))
(79999 foo 80001))
;; displaced arrays
(defvar *displaced* nil)
(setf *displaced* (make-int-array 100000))
(deftest make-sequence-list-1
(make-sequence 'list 0)
nil)
(defun make-displaced-array (n displacement)
(make-array n :displaced-to *displaced*
:displaced-index-offset displacement))
(deftest make-sequence-list-2
(make-sequence 'list 5 :initial-element 'g)
(g g g g g))
(deftest elt-displaced-array-1
(handler-case
(elt (make-displaced-array '(0) 100) 0)
(type-error () 'type-error)
(error (c) c))
type-error)
(deftest make-sequence-list-3
(length (make-sequence 'list 100))
(deftest elt-displaced-array-2
(elt (make-displaced-array '(1) 100) 0)
100)
(deftest make-sequence-list-4
(length (make-sequence 'list 123456))
123456)
(deftest elt-displaced-array-3
(elt (make-displaced-array '(5) 100) 4)
104)
(deftest make-sequence-list-5
(let ((x (make-sequence 'list 1000)))
(every #'(lambda (e) (eq (car x) e)) (cdr x)))
t)
#|
(deftest elt-displaced-array-4
(handler-case
(make-displaced-array '(100) 100000)
(type-error () 'type-error)
(error (c) c))
type-error)
|#
#|
(deftest elt-displaced-array-5
(handler-case
(make-displaced-array '(100) (- 100000 50))
(type-error () 'type-error)
(error (c) c))
type-error)
|#
......@@ -69,8 +69,8 @@
;;; Tests of sequences
;;; (load "copy-seq.lsp")
;;; (load "elt.lsp")
;;; (load "fill.lsp")
(load "elt.lsp")
(load "fill.lsp")
(load "fill-strings.lsp")
(load "make-sequence.lsp")
;;; (load "subseq.lsp")
......@@ -94,6 +94,7 @@
(load "search-string.lsp")
(load "mismatch.lsp")
(load "replace.lsp")
(load "subseq.lsp")
(load "substitute.lsp")
(load "substitute-if.lsp")
(load "substitute-if-not.lsp")
......
No preview for this file type
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