Commit b14aac6f authored by pfdietz's avatar pfdietz

Tests for VECTOR-PUSH, and MAKE-ARRAY tests on more specialized element types.

parent 9975cb59
......@@ -152,6 +152,7 @@
(load "upgraded-array-element-type.lsp")
(load "vector.lsp")
(load "vector-pop.lsp")
(load "vector-push.lsp")
;;; Tests of packages
......
......@@ -225,6 +225,47 @@
(make-string len :initial-element #\)))))))
t)
(deftest make-array.29
(make-array-with-checks '(5) :element-type '(integer 0 (256))
:initial-contents '(0 5 255 119 57))
#(0 5 255 119 57))
(deftest make-array.30
(make-array-with-checks '(5) :element-type '(integer -128 127)
:initial-contents '(-10 5 -128 86 127))
#(-10 5 -128 86 127))
(deftest make-array.31
(make-array-with-checks '(5) :element-type '(integer 0 (65536))
:initial-contents '(0 100 65535 7623 13))
#(0 100 65535 7623 13))
(deftest make-array.32
(make-array-with-checks '(5) :element-type 'fixnum
:initial-contents '(1 2 3 4 5))
#(1 2 3 4 5))
(deftest make-array.33
(make-array-with-checks '(5) :element-type 'short-float
:initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))
#(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))
(deftest make-array.34
(make-array-with-checks '(5) :element-type 'single-float
:initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))
#(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))
(deftest make-array.35
(make-array-with-checks '(5) :element-type 'double-float
:initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
#(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
(deftest make-array.36
(make-array-with-checks '(5) :element-type 'long-float
:initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))
#(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))
;;; Adjustable arrays
(deftest make-array.adjustable.1
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Jan 25 00:55:43 2003
;;;; Contains: Tests for VECTOR-PUSH
(in-package :cl-test)
(deftest vector-push.1
(let ((a (make-array '(5) :fill-pointer 2
:initial-contents '(a b c d e))))
(values
(fill-pointer a)
(vector-push 'x a)
(fill-pointer a)
a))
2 2 3 #(a b x))
(deftest vector-push.2
(let ((a (make-array '(5) :fill-pointer 5
:initial-contents '(a b c d e))))
(values
(fill-pointer a)
(vector-push 'x a)
(fill-pointer a)
a))
5 nil 5 #(a b c d e))
(deftest vector-push.3
(let ((a (make-array '(5) :fill-pointer 2
:initial-contents "abcde"
:element-type 'base-char)))
(values
(fill-pointer a)
(vector-push #\x a)
(fill-pointer a)
a))
2 2 3 "abx")
(deftest vector-push.4
(let ((a (make-array '(5) :fill-pointer 5
:initial-contents "abcde"
:element-type 'base-char)))
(values
(fill-pointer a)
(vector-push #\x a)
(fill-pointer a)
a))
5 nil 5 "abcde")
(deftest vector-push.5
(let ((a (make-array '(5) :fill-pointer 2
:initial-contents "abcde"
:element-type 'character)))
(values
(fill-pointer a)
(vector-push #\x a)
(fill-pointer a)
a))
2 2 3 "abx")
(deftest vector-push.6
(let ((a (make-array '(5) :fill-pointer 5
:initial-contents "abcde"
:element-type 'character)))
(values
(fill-pointer a)
(vector-push #\x a)
(fill-pointer a)
a))
5 nil 5 "abcde")
(deftest vector-push.7
(let ((a (make-array '(5) :fill-pointer 2
:initial-contents '(0 1 1 0 0)
:element-type 'bit)))
(values
(fill-pointer a)
(vector-push 0 a)
(fill-pointer a)
a))
2 2 3 #*010)
(deftest vector-push.8
(let ((a (make-array '(5) :fill-pointer 5
:initial-contents '(0 0 0 0 0)
:element-type 'bit)))
(values
(fill-pointer a)
(vector-push 1 a)
(fill-pointer a)
a))
5 nil 5 #*00000)
(deftest vector-push.9
(let ((a (make-array '(5) :fill-pointer 2
:initial-contents '(1 2 3 4 5)
:element-type 'fixnum)))
(values
(fill-pointer a)
(vector-push 0 a)
(fill-pointer a)
a))
2 2 3 #(1 2 0))
(deftest vector-push.10
(let ((a (make-array '(5) :fill-pointer 5
:initial-contents '(1 2 3 4 5)
:element-type 'fixnum)))
(values
(fill-pointer a)
(vector-push 0 a)
(fill-pointer a)
a))
5 nil 5 #(1 2 3 4 5))
(deftest vector-push.11
(let ((a (make-array '(5) :fill-pointer 2
:initial-contents '(1 2 3 4 5)
:element-type '(integer 0 (256)))))
(values
(fill-pointer a)
(vector-push 0 a)
(fill-pointer a)
a))
2 2 3 #(1 2 0))
(deftest vector-push.12
(let ((a (make-array '(5) :fill-pointer 5
:initial-contents '(1 2 3 4 5)
:element-type '(integer 0 (256)))))
(values
(fill-pointer a)
(vector-push 0 a)
(fill-pointer a)
a))
5 nil 5 #(1 2 3 4 5))
(deftest vector-push.13
(let ((a (make-array '(5) :fill-pointer 2
:initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0)
:element-type 'short-float)))
(values
(fill-pointer a)
(vector-push 0.0s0 a)
(fill-pointer a)
a))
2 2 3 #(1.0s0 2.0s0 0.0s0))
(deftest vector-push.14
(let ((a (make-array '(5) :fill-pointer 5
:initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0)
:element-type 'short-float)))
(values
(fill-pointer a)
(vector-push 0.0s0 a)
(fill-pointer a)
a))
5 nil 5 #(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))
(deftest vector-push.15
(let ((a (make-array '(5) :fill-pointer 2
:initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0)
:element-type 'single-float)))
(values
(fill-pointer a)
(vector-push 0.0f0 a)
(fill-pointer a)
a))
2 2 3 #(1.0f0 2.0f0 0.0f0))
(deftest vector-push.16
(let ((a (make-array '(5) :fill-pointer 5
:initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0)
:element-type 'single-float)))
(values
(fill-pointer a)
(vector-push 0.0f0 a)
(fill-pointer a)
a))
5 nil 5 #(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))
(deftest vector-push.17
(let ((a (make-array '(5) :fill-pointer 2
:initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)
:element-type 'double-float)))
(values
(fill-pointer a)
(vector-push 0.0d0 a)
(fill-pointer a)
a))
2 2 3 #(1.0d0 2.0d0 0.0d0))
(deftest vector-push.18
(let ((a (make-array '(5) :fill-pointer 5
:initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)
:element-type 'double-float)))
(values
(fill-pointer a)
(vector-push 0.0d0 a)
(fill-pointer a)
a))
5 nil 5 #(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
(deftest vector-push.19
(let ((a (make-array '(5) :fill-pointer 2
:initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0)
:element-type 'long-float)))
(values
(fill-pointer a)
(vector-push 0.0l0 a)
(fill-pointer a)
a))
2 2 3 #(1.0l0 2.0l0 0.0l0))
(deftest vector-push.20
(let ((a (make-array '(5) :fill-pointer 5
:initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0)
:element-type 'long-float)))
(values
(fill-pointer a)
(vector-push 0.0l0 a)
(fill-pointer a)
a))
5 nil 5 #(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))
;;; Error tests
(defun vector-push-error-test (seq val)
(handler-case
(eval `(let ((a (copy-seq ,seq)))
(or (notnot (array-has-fill-pointer-p a))
(vector-push ',val a))))
(error () t)))
(deftest vector-push.error.1
(vector-push-error-test #(a b c d) 'x)
t)
(deftest vector-push.error.2
(vector-push-error-test #*00000 1)
t)
(deftest vector-push.error.3
(vector-push-error-test "abcde" #\x)
t)
(deftest vector-push.error.4
(vector-push-error-test #() 'x)
t)
(deftest vector-push.error.5
(vector-push-error-test #* 1)
t)
(deftest vector-push.error.6
(vector-push-error-test "" #\x)
t)
(deftest vector-push.error.7
(vector-push-error-test (make-array '5 :element-type 'base-char
:initial-element #\a)
#\x)
t)
(deftest vector-push.error.8
(vector-push-error-test (make-array '5 :element-type '(integer 0 (256))
:initial-element 0)
17)
t)
(deftest vector-push.error.9
(vector-push-error-test (make-array '5 :element-type 'float
:initial-element 1.0)
2.0)
t)
(deftest vector-push.error.10
(vector-push-error-test (make-array '5 :element-type 'short-float
:initial-element 1.0s0)
2.0s0)
t)
(deftest vector-push.error.11
(vector-push-error-test (make-array '5 :element-type 'long-float
:initial-element 1.0l0)
2.0l0)
t)
(deftest vector-push.error.12
(vector-push-error-test (make-array '5 :element-type 'single-float
:initial-element 1.0f0)
2.0f0)
t)
(deftest vector-push.error.13
(vector-push-error-test (make-array '5 :element-type 'double-float
:initial-element 1.0d0)
2.0d0)
t)
(deftest vector-push.error.14
(classify-error (vector-push))
program-error)
(deftest vector-push.error.15
(classify-error (vector-push (vector 1 2 3)))
program-error)
(deftest vector-push.error.16
(classify-error (vector-push (vector 1 2 3) 4 nil))
program-error)
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