Commit 5b0dc8bf authored by pfdietz's avatar pfdietz

Added more tests for (VECTOR ...) types, added tests for the

functions VECTOR and VECTOR-POP.
parent 30e82c01
......@@ -151,6 +151,7 @@
(load "svref.lsp")
(load "upgraded-array-element-type.lsp")
(load "vector.lsp")
(load "vector-pop.lsp")
;;; Tests of packages
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Fri Jan 24 07:46:29 2003
;;;; Contains: Tests for VECTOR-POP
(in-package :cl-test)
(deftest vector-pop.1
(let ((v (make-array '(5) :initial-contents '(a b c d e)
:fill-pointer 3)))
(values
(length v)
(check-values (vector-pop v))
(fill-pointer v)
(length v)
v))
3 c 2 2 #(a b))
;;; Error cases
(deftest vector-pop.error.1
(classify-error (vector-pop (vector 1 2 3)))
type-error)
(deftest vector-pop.error.2
(let ((v (make-array '(5) :initial-element 'x
:fill-pointer 0)))
(handler-case (vector-pop v)
(error () 'error)))
error)
(deftest vector-pop.error.3
(classify-error (vector-pop))
program-error)
(deftest vector-pop.error.4
(classify-error (let ((v (make-array '(5) :fill-pointer t
:initial-element 'x)))
(vector-pop v nil)))
program-error)
......@@ -126,3 +126,104 @@
(deftest vector.type.30
(typep "abcde" '(vector t *))
nil)
(deftest vector.type.31
(let ((s (coerce "abc" 'simple-base-string)))
(notnot-mv (typep s '(vector base-char))))
t)
(deftest vector.type.32
(let ((s (coerce "abc" 'simple-base-string)))
(notnot-mv (typep s '(vector base-char 3))))
t)
(deftest vector.type.33
(let ((s (coerce "abc" 'simple-base-string)))
(typep s '(vector base-char 2)))
nil)
(deftest vector.type.34
(let ((s (coerce "abc" 'simple-base-string)))
(typep s '(vector base-char 4)))
nil)
(deftest vector.type.35
(let ((s (coerce "abc" 'simple-base-string)))
(notnot-mv (typep s 'vector)))
t)
(deftest vector.type.36
(let ((s (coerce "abc" 'simple-base-string)))
(notnot-mv (typep s '(vector *))))
t)
(deftest vector.type.37
(let ((s (coerce "abc" 'simple-base-string)))
(notnot-mv (typep s '(vector * 3))))
t)
(deftest vector.type.38
(let ((s (coerce "abc" 'simple-base-string)))
(notnot-mv (typep s '(vector * *))))
t)
(deftest vector.type.39
(let ((s (coerce "abc" 'simple-base-string)))
(typep s '(vector t)))
nil)
(deftest vector.type.40
(let ((s (coerce "abc" 'simple-base-string)))
(typep s '(vector t *)))
nil)
;;;; Tests of the function VECTOR
(deftest vector.1
(vector)
#())
(deftest vector.2
(vector 1 2 3)
#(1 2 3))
(deftest vector.3
(let* ((len (min 1000 (1- call-arguments-limit)))
(args (make-int-list len))
(v (apply #'vector args)))
(and
(typep v '(vector t))
(typep v '(vector t *))
(typep v `(vector t ,len))
(typep v 'simple-vector)
(typep v `(simple-vector ,len))
(eql (length v) len)
(loop for i from 0
for e across v
always (eql i e))
t))
t)
(deftest vector.4
(notnot-mv (typep (vector) '(vector t 0)))
t)
(deftest vector.5
(notnot-mv (typep (vector) 'simple-vector))
t)
(deftest vector.6
(notnot-mv (typep (vector) '(simple-vector 0)))
t)
(deftest vector.7
(notnot-mv (typep (vector 1 2 3) 'simple-vector))
t)
(deftest vector.8
(notnot-mv (typep (vector 1 2 3) '(simple-vector 3)))
t)
(deftest vector.9
(typep (vector #\a #\b #\c) 'string)
nil)
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