fill-pointer.lsp 1.88 KB
Newer Older
pfdietz's avatar
pfdietz committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Jan 21 22:14:23 2003
;;;; Contains: Tests of FILL-POINTER

(in-package :cl-test)

;;; 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
		       :initial-contents '(1 2 3 4 5 6 7 8 9 10))))
    (values
     (fill-pointer a)
     (setf (fill-pointer a) 6)
     a))
  5 6 #(1 2 3 4 5 6))

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
(deftest fill-pointer.order.1
  (let ((i 0)
	(a (make-array '(10) :fill-pointer 5)))
    (values
     (fill-pointer (progn (incf i) a))
     i))
  5 1)

(deftest fill-pointer.order.2
  (let ((i 0) x y
	(a (make-array '(10) :fill-pointer 5
		       :initial-contents '(1 2 3 4 5 6 7 8 9 10))))
    (values
     i
     (setf (fill-pointer (progn (setf x (incf i)) a))
	   (progn (setf y (incf i)) 6))
     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
55
56
  (signals-error (fill-pointer (make-array '(10) :fill-pointer 4) nil)
		 program-error)
  t)
pfdietz's avatar
pfdietz committed
57
58

(deftest fill-pointer.error.3
59
60
61
  (signals-error (fill-pointer (make-array '(10) :fill-pointer nil))
		 type-error)
  t)
pfdietz's avatar
pfdietz committed
62
63

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

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

(deftest fill-pointer.error.6
72
73
74
75
76
77
78
  (loop for e in *mini-universe*
	when (and (or (not (typep e 'vector))
		      (not (array-has-fill-pointer-p e)))
		  (not (eval `(signals-error
			       (fill-pointer ',e)
			       type-error))))
	collect (list e))
pfdietz's avatar
pfdietz committed
79
  nil)
80
81

(deftest fill-pointer.error.7
82
83
84
  (signals-error (locally (fill-pointer #2a((a b c)(d e f))) t)
		 type-error)
  t)