fill-pointer.lsp 1.94 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Jan 21 22:14:23 2003
;;;; Contains: Tests of FILL-POINTER

6

pfdietz's avatar
pfdietz committed
7 8 9 10 11 12 13 14 15 16 17 18 19

;;; More tests are in make-array.lsp

(deftest fill-pointer.1
  (fill-pointer (make-array '(10) :fill-pointer 5))
  5)

(deftest fill-pointer.2
  (fill-pointer (make-array '(10) :fill-pointer t))
  10)

(deftest fill-pointer.3
  (let ((a (make-array '(10) :fill-pointer 5
sds's avatar
sds committed
20
                       :initial-contents '(1 2 3 4 5 6 7 8 9 10))))
pfdietz's avatar
pfdietz committed
21 22 23 24 25 26
    (values
     (fill-pointer a)
     (setf (fill-pointer a) 6)
     a))
  5 6 #(1 2 3 4 5 6))

27 28
(deftest fill-pointer.order.1
  (let ((i 0)
sds's avatar
sds committed
29
        (a (make-array '(10) :fill-pointer 5)))
30 31 32 33 34 35 36
    (values
     (fill-pointer (progn (incf i) a))
     i))
  5 1)

(deftest fill-pointer.order.2
  (let ((i 0) x y
sds's avatar
sds committed
37 38
        (a (make-array '(10) :fill-pointer 5
                       :initial-contents '(1 2 3 4 5 6 7 8 9 10))))
39 40 41
    (values
     i
     (setf (fill-pointer (progn (setf x (incf i)) a))
sds's avatar
sds committed
42
           (progn (setf y (incf i)) 6))
43 44 45 46
     a
     i x y))
  0 6 #(1 2 3 4 5 6) 2 1 2)

pfdietz's avatar
pfdietz committed
47 48 49
;;; Error tests

(deftest fill-pointer.error.1
50 51
  (signals-error (fill-pointer) program-error)
  t)
pfdietz's avatar
pfdietz committed
52 53

(deftest fill-pointer.error.2
54
  (signals-error (fill-pointer (make-array '(10) :fill-pointer 4) nil)
sds's avatar
sds committed
55
                 program-error)
56
  t)
pfdietz's avatar
pfdietz committed
57 58

(deftest fill-pointer.error.3
59 60
  (let ((a (make-array '(10) :fill-pointer nil)))
    (if (array-has-fill-pointer-p a)
sds's avatar
sds committed
61
        t
62
      (eval `(signals-error (fill-pointer ',a) type-error))))
63
  t)
pfdietz's avatar
pfdietz committed
64 65

(deftest fill-pointer.error.4
66 67
  (signals-error (fill-pointer #0aNIL) type-error)
  t)
pfdietz's avatar
pfdietz committed
68 69

(deftest fill-pointer.error.5
70 71
  (signals-error (fill-pointer #2a((a b c)(d e f))) type-error)
  t)
pfdietz's avatar
pfdietz committed
72 73

(deftest fill-pointer.error.6
74
  (check-type-error #'fill-pointer #'(lambda (x) (and (vectorp x)
sds's avatar
sds committed
75
                                                      (array-has-fill-pointer-p x))))
pfdietz's avatar
pfdietz committed
76
  nil)
77 78

(deftest fill-pointer.error.7
79
  (signals-error (locally (fill-pointer #2a((a b c)(d e f))) t)
sds's avatar
sds committed
80
                 type-error)
81
  t)