← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/copy-seq.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/copy-seq.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat Nov  2 21:38:08 2002
 
4
;;;; Contains: Tests for COPY-SEQ
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
;;; This function is extensively used elsewhere, but is tested again
 
9
;;; here for completeness.
 
10
 
 
11
(deftest copy-seq.1
 
12
  (copy-seq nil)
 
13
  nil)
 
14
 
 
15
(deftest copy-seq.2
 
16
  (let* ((s1 '(a b c))
 
17
         (s2 (check-values (copy-seq s1))))
 
18
    (and (not (eql s1 s2))
 
19
         (equalt s1 s2)))
 
20
  t)
 
21
 
 
22
(deftest copy-seq.3
 
23
  (let* ((s1 #(a b c))
 
24
         (s2 (check-values (copy-seq s1))))
 
25
    (and (not (eql s1 s2)) s2))
 
26
  #(a b c))
 
27
 
 
28
(deftest copy-seq.4
 
29
  (let* ((s1 (make-array '(4) :initial-contents '(a b c d)
 
30
                         :adjustable t))
 
31
         (s2 (check-values (copy-seq s1))))
 
32
    (and (not (eql s1 s2))
 
33
         (simple-vector-p s2)
 
34
         s2))
 
35
  #(a b c d))
 
36
 
 
37
 
 
38
(deftest copy-seq.5
 
39
  (let* ((s1 (make-array '(4) :initial-contents '(a b c d)
 
40
                         :fill-pointer 3))
 
41
         (s2 (check-values (copy-seq s1))))
 
42
    (and (not (eql s1 s2))
 
43
         (simple-vector-p s2)
 
44
         s2))
 
45
  #(a b c))
 
46
 
 
47
(deftest copy-seq.6
 
48
  (let* ((a1 (make-array '(6) :initial-contents '(a b c d e f)))
 
49
         (a2 (make-array '(4) :displaced-to a1
 
50
                         :displaced-index-offset 1))
 
51
         (s2 (check-values (copy-seq a2))))
 
52
    (and (not (eql a2 s2))
 
53
         (simple-vector-p s2)
 
54
         s2))
 
55
  #(b c d e))
 
56
 
 
57
(deftest copy-seq.7
 
58
  (let* ((s1 (make-array '(4)
 
59
                         :element-type 'base-char
 
60
                         :initial-contents '(#\a #\b #\c #\d)
 
61
                         :adjustable t))
 
62
         (s2 (check-values (copy-seq s1))))
 
63
    (and (not (eql s1 s2))
 
64
         (simple-string-p s2)
 
65
         s2))
 
66
  "abcd")
 
67
 
 
68
 
 
69
(deftest copy-seq.8
 
70
  (let* ((s1 (make-array '(4)
 
71
                         :element-type 'base-char
 
72
                         :initial-contents '(#\a #\b #\c #\d)
 
73
                         :fill-pointer 3))
 
74
         (s2 (check-values (copy-seq s1))))
 
75
    (and (not (eql s1 s2))
 
76
         (simple-string-p s2)
 
77
         s2))
 
78
  "abc")
 
79
 
 
80
(deftest copy-seq.9
 
81
  (let* ((a1 (make-array '(6) :initial-contents '(#\a #\b #\c #\d #\e #\f)
 
82
                         :element-type 'base-char))
 
83
         (a2 (make-array '(4) :displaced-to a1
 
84
                         :element-type 'base-char
 
85
                         :displaced-index-offset 1))
 
86
         (s2 (check-values (copy-seq a2))))
 
87
    (and (not (eql a2 s2))
 
88
         (simple-string-p s2)
 
89
         s2))
 
90
  "bcde")
 
91
 
 
92
(deftest copy-seq.10
 
93
  (let*((s1 "abcd")
 
94
        (s2 (check-values (copy-seq s1))))
 
95
    (and (not (eql s1 s2))
 
96
         s2))
 
97
  "abcd")
 
98
 
 
99
(deftest copy-seq.11
 
100
  (let* ((s1 #*0010110)
 
101
         (s2 (check-values (copy-seq s1))))
 
102
    (and (not (eql s1 s2))
 
103
         (simple-bit-vector-p s2)
 
104
         s2))
 
105
  #*0010110)
 
106
 
 
107
(deftest copy-seq.12
 
108
  (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0)
 
109
                         :element-type 'bit
 
110
                         :adjustable t))
 
111
         (s2 (check-values (copy-seq s1))))
 
112
    (and (not (eql s1 s2))
 
113
         (simple-bit-vector-p s2)
 
114
         s2))
 
115
  #*0010)
 
116
 
 
117
(deftest copy-seq.13
 
118
  (let* ((s1 (make-array '(4) :initial-contents '(0 0 1 0)
 
119
                         :element-type 'bit
 
120
                         :fill-pointer 3))
 
121
         (s2 (check-values (copy-seq s1))))
 
122
    (and (not (eql s1 s2))
 
123
         (simple-bit-vector-p s2)
 
124
         s2))
 
125
  #*001)
 
126
 
 
127
(deftest copy-seq.14
 
128
  (let* ((a1 (make-array '(6) :initial-contents '(0 0 1 0 1 1)
 
129
                         :element-type 'bit))
 
130
         (a2 (make-array '(4) :displaced-to a1
 
131
                         :displaced-index-offset 1
 
132
                         :element-type 'bit))
 
133
         (s2 (check-values (copy-seq a2))))
 
134
    (and (not (eql a2 s2))
 
135
         (simple-bit-vector-p s2)
 
136
         s2))
 
137
  #*0101)
 
138
 
 
139
(deftest copy-seq.15
 
140
  (copy-seq "")
 
141
  "")
 
142
 
 
143
(deftest copy-seq.16
 
144
  (copy-seq #*)
 
145
  #*)
 
146
 
 
147
(deftest copy-seq.17
 
148
  (copy-seq #())
 
149
  #())
 
150
 
 
151
(deftest copy-seq.18
 
152
  (let* ((x (make-array '(10) :initial-contents '(a b c d e f g h i j)))
 
153
         (y (check-values (copy-seq x))))
 
154
    (equal-array x y))
 
155
  t)
 
156
 
 
157
(deftest copy-seq.19
 
158
  :notes (:nil-vectors-are-strings)
 
159
  (copy-seq (make-array '(0) :element-type nil))
 
160
  "")
 
161
 
 
162
(deftest copy-seq.order.1
 
163
  (let ((i 0))
 
164
    (values (copy-seq (progn (incf i) "abc")) i))
 
165
  "abc" 1)
 
166
 
 
167
;;; Error tests
 
168
 
 
169
(deftest copy-seq.error.1
 
170
  (signals-error (copy-seq 10) type-error)
 
171
  t)
 
172
 
 
173
(deftest copy-seq.error.2
 
174
  (signals-error (copy-seq 'a) type-error)
 
175
  t)
 
176
 
 
177
(deftest copy-seq.error.3
 
178
  (signals-error (copy-seq 13.21) type-error)
 
179
  t)
 
180
 
 
181
(deftest copy-seq.error.4
 
182
  (signals-error (copy-seq) program-error)
 
183
  t)
 
184
 
 
185
(deftest copy-seq.error.5
 
186
  (signals-error (copy-seq "abc" 2 nil) program-error)
 
187
  t)
 
188
 
 
189
(deftest copy-seq.error.6
 
190
  (signals-error (locally (copy-seq 10) t) type-error)
 
191
  t)
 
192
 
 
193