Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
ansi-test
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
Karsten Poeck
ansi-test
Commits
f469d2e5
Commit
f469d2e5
authored
Aug 28, 2004
by
pfdietz
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Added tests for various specialized vectors (specialized array element
types, fill pointers, adjustable, displaced.)
parent
e44b5dcc
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
653 additions
and
0 deletions
+653
-0
ansi-tests/every.lsp
ansi-tests/every.lsp
+117
-0
ansi-tests/notany.lsp
ansi-tests/notany.lsp
+177
-0
ansi-tests/notevery.lsp
ansi-tests/notevery.lsp
+180
-0
ansi-tests/some.lsp
ansi-tests/some.lsp
+179
-0
No files found.
ansi-tests/every.lsp
View file @
f469d2e5
...
...
@@ -143,6 +143,120 @@
(every #'alpha-char-p v)))
t #\0 nil)
;;; Displaced vectors
(deftest every.23
(let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1)))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2)))
(values
(every #'evenp v1)
(notnot (every 'evenp v2))))
nil t)
(deftest every.24
(loop for i from 1 to 40
for type = `(unsigned-byte ,i)
unless
(let* ((v1 (make-array '(10) :initial-contents '(1 1 0 0 0 0 1 1 1 1)
:element-type type))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2
:element-type type)))
(and (not (every 'evenp v1))
(every #'evenp v2)))
collect i)
nil)
(deftest every.25
(loop for i from 1 to 40
for type = `(signed-byte ,i)
unless
(let* ((v1 (make-array '(10) :initial-contents '(-1 -1 0 0 0 0 -1 -1 -1 -1)
:element-type type))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2
:element-type type)))
(and (not (every 'evenp v1))
(every #'evenp v2)))
collect i)
nil)
(deftest every.26
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'character
:displaced-to s1
:displaced-index-offset i)
collect (notnot (every 'alpha-char-p s2))))
(nil nil t t nil nil nil))
(deftest every.27
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'base-char)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'base-char
:displaced-to s1
:displaced-index-offset i)
collect (notnot (every 'alpha-char-p s2))))
(nil nil t t nil nil nil))
;;; adjustable vectors
(deftest every.28
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:adjustable t)))
(values
(notnot (every #'plusp v))
(progn
(adjust-array v '(11) :initial-element -1)
(every #'plusp v))))
t nil)
(deftest every.29
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:fill-pointer 10
:adjustable t)))
(values
(notnot (every #'plusp v))
(progn
(adjust-array v '(11) :initial-element -1)
(every #'plusp v))))
t t)
;;; Float, complex vectors
(deftest every.30
(loop for type in '(short-float single-float double-float long-float)
for v = (make-array '(6)
:element-type type
:initial-contents
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6)))
unless (every #'plusp v)
collect (list type v))
nil)
(deftest every.31
(loop for type in '(short-float single-float double-float long-float)
for v = (make-array '(6)
:element-type type
:fill-pointer 5
:initial-contents
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 -1)))
unless (every #'plusp v)
collect (list type v))
nil)
(deftest every.32
(loop for type in '(short-float single-float double-float long-float)
for ctype = `(complex ,type)
for v = (make-array '(6)
:element-type ctype
:initial-contents
(mapcar #'(lambda (x) (complex x (coerce x type))) '(1 2 3 4 5 6)))
unless (every #'complexp v)
collect (list type v))
nil)
;;; Order of arguments
(deftest every.order.1
...
...
@@ -216,3 +330,6 @@
(signals-error (every #'car '(a b c)) type-error)
t)
(deftest every.error.14
(signals-error (every #'identity '(1 2 3 . 4)) type-error)
t)
ansi-tests/notany.lsp
View file @
f469d2e5
...
...
@@ -79,6 +79,183 @@
(notany 'null '(1 2 3 nil 5))
nil)
;;; Other specialized sequences
(deftest notany.17
(let ((v (make-array '(10) :initial-contents '(0 0 0 0 1 2 3 4 5 6)
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notany #'plusp v))))
(nil nil nil nil nil t t t t t))
(deftest notany.18
(loop for i from 1 to 40
for type = `(unsigned-byte ,i)
unless
(let ((v (make-array '(10) :initial-contents (loop for j in '(0 0 0 0 1 2 3 4 5 6)
collect (mod j (ash 1 i)))
:element-type type
:fill-pointer 4)))
(equal (loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notany #'plusp v)))
'(nil nil nil nil nil t t t t t)))
collect i)
nil)
(deftest notany.19
(loop for i from 1 to 40
for type = `(signed-byte ,i)
unless
(let ((v (make-array '(10) :initial-contents '(0 0 0 0 -1 -1 -1 -1 -1 -1)
:element-type type
:fill-pointer 4)))
(equal (loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notany #'minusp v)))
'(nil nil nil nil nil t t t t t)))
collect i)
nil)
(deftest notany.20
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'character
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notany #'digit-char-p v))))
(nil nil nil nil nil t t t t t))
(deftest notany.21
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'base-char
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notany #'digit-char-p v))))
(nil nil nil nil nil t t t t t))
(deftest notany.22
(let ((v (make-array '(5) :initial-contents "abcde"
:element-type 'base-char)))
(values
(notnot (notany #'digit-char-p v))
(setf (aref v 2) #\0)
(notany #'digit-char-p v)))
t #\0 nil)
(deftest notany.23
(loop for type in '(short-float single-float double-float long-float)
for v = (make-array '(9)
:element-type type
:initial-contents
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6 0 8 3)))
when (notany #'zerop v)
collect (list type v))
nil)
(deftest notany.24
(loop for type in '(short-float single-float double-float long-float)
for v = (make-array '(9)
:element-type type
:fill-pointer 6
:initial-contents
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6 0 8 3)))
unless (notany #'zerop v)
collect (list type v))
nil)
(deftest notany.25
(loop for type in '(short-float single-float double-float long-float)
for ctype = `(complex ,type)
for v = (make-array '(6)
:element-type ctype
:initial-contents
(mapcar #'(lambda (x) (complex x (coerce x type))) '(1 2 3 4 5 6)))
unless (notany (complement #'complexp) v)
collect (list type v))
nil)
;;; Displaced vectors
(deftest notany.26
(let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1)))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2)))
(values
(notany #'oddp v1)
(notnot (notany #'oddp v2))))
nil t)
(deftest notany.27
(loop for i from 1 to 40
for type = `(unsigned-byte ,i)
unless
(let* ((v1 (make-array '(10) :initial-contents '(1 1 0 0 0 0 1 1 1 1)
:element-type type))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2
:element-type type)))
(and (not (notany 'oddp v1))
(notany #'oddp v2)))
collect i)
nil)
(deftest notany.28
(loop for i from 1 to 40
for type = `(signed-byte ,i)
unless
(let* ((v1 (make-array '(10) :initial-contents '(-1 -1 0 0 0 0 -1 -1 -1 -1)
:element-type type))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2
:element-type type)))
(and (not (notany 'oddp v1))
(notany #'oddp v2)))
collect i)
nil)
(deftest notany.29
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'character
:displaced-to s1
:displaced-index-offset i)
collect (not (notany 'digit-char-p s2))))
(t t nil nil t t t))
(deftest notany.30
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'base-char)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'base-char
:displaced-to s1
:displaced-index-offset i)
collect (not (notany 'digit-char-p s2))))
(t t nil nil t t t))
(deftest notany.31
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:adjustable t)))
(values
(notnot (notany #'minusp v))
(progn
(adjust-array v '(11) :initial-element -1)
(notany #'minusp v))))
t nil)
(deftest notany.32
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:fill-pointer 10
:adjustable t)))
(values
(notnot (notany #'minusp v))
(progn
(adjust-array v '(11) :initial-element -1)
(notnot (notany #'minusp v)))))
t t)
(deftest notany.order.1
(let ((i 0) a b)
(values
...
...
ansi-tests/notevery.lsp
View file @
f469d2e5
...
...
@@ -79,6 +79,186 @@
(notevery 'null '(nil nil nil nil))
nil)
;;; Other specialized sequences
(deftest notevery.17
(let ((v (make-array '(10) :initial-contents '(0 0 0 0 1 2 3 4 5 6)
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notevery #'zerop v))))
(t t t t t nil nil nil nil nil))
(deftest notevery.18
(loop for i from 1 to 40
for type = `(unsigned-byte ,i)
unless
(let ((v (make-array '(10) :initial-contents '(0 0 0 0 1 1 1 1 1 1)
:element-type type
:fill-pointer 4)))
(equal (loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notevery #'zerop v)))
'(t t t t t nil nil nil nil nil)))
collect i)
nil)
(deftest notevery.19
(loop for i from 1 to 40
for type = `(signed-byte ,i)
unless
(let ((v (make-array '(10) :initial-contents '(0 0 0 0 -1 -1 -1 -1 -1 -1)
:element-type type
:fill-pointer 4)))
(equal (loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notevery #'zerop v)))
'(t t t t t nil nil nil nil nil)))
collect i)
nil)
(deftest notevery.20
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'character
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notevery #'alpha-char-p v))))
(t t t t t nil nil nil nil nil))
(deftest notevery.21
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'base-char
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (not (notevery #'alpha-char-p v))))
(t t t t t nil nil nil nil nil))
(deftest notevery.22
(let ((v (make-array '(5) :initial-contents "abcde"
:element-type 'base-char)))
(values
(not (notevery #'alpha-char-p v))
(setf (aref v 2) #\0)
(not (notevery #'alpha-char-p v))))
t #\0 nil)
;;; Displaced vectors
(deftest notevery.23
(let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1)))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2)))
(values
(not (notevery #'evenp v1))
(not (notevery 'evenp v2))))
nil t)
(deftest notevery.24
(loop for i from 1 to 40
for type = `(unsigned-byte ,i)
unless
(let* ((v1 (make-array '(10) :initial-contents '(1 1 0 0 0 0 1 1 1 1)
:element-type type))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2
:element-type type)))
(and (notevery 'evenp v1)
(not (notevery #'evenp v2))))
collect i)
nil)
(deftest notevery.25
(loop for i from 1 to 40
for type = `(signed-byte ,i)
unless
(let* ((v1 (make-array '(10) :initial-contents '(-1 -1 0 0 0 0 -1 -1 -1 -1)
:element-type type))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2
:element-type type)))
(and (notevery 'evenp v1)
(not (notevery #'evenp v2))))
collect i)
nil)
(deftest notevery.26
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'character
:displaced-to s1
:displaced-index-offset i)
collect (not (notevery 'alpha-char-p s2))))
(nil nil t t nil nil nil))
(deftest notevery.27
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'base-char)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'base-char
:displaced-to s1
:displaced-index-offset i)
collect (not (notevery 'alpha-char-p s2))))
(nil nil t t nil nil nil))
;;; adjustable vectors
(deftest notevery.28
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:adjustable t)))
(values
(not (notevery #'plusp v))
(progn
(adjust-array v '(11) :initial-element -1)
(not (notevery #'plusp v)))))
t nil)
(deftest notevery.29
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:fill-pointer 10
:adjustable t)))
(values
(not (notevery #'plusp v))
(progn
(adjust-array v '(11) :initial-element -1)
(not (notevery #'plusp v)))))
t t)
;;; Float, complex vectors
(deftest notevery.30
(loop for type in '(short-float single-float double-float long-float)
for v = (make-array '(6)
:element-type type
:initial-contents
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6)))
when (notevery #'plusp v)
collect (list type v))
nil)
(deftest notevery.31
(loop for type in '(short-float single-float double-float long-float)
for v = (make-array '(6)
:element-type type
:fill-pointer 5
:initial-contents
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 -1)))
when (notevery #'plusp v)
collect (list type v))
nil)
(deftest notevery.32
(loop for type in '(short-float single-float double-float long-float)
for ctype = `(complex ,type)
for v = (make-array '(6)
:element-type ctype
:initial-contents
(mapcar #'(lambda (x) (complex x (coerce x type))) '(1 2 3 4 5 6)))
when (notevery #'complexp v)
collect (list type v))
nil)
(deftest notevery.order.1
(let ((i 0) a b)
(values
...
...
ansi-tests/some.lsp
View file @
f469d2e5
...
...
@@ -78,6 +78,182 @@
(not-mv (some 'null '(1 2 3 nil 5)))
nil)
;;; Other specialized sequences
(deftest some.17
(let ((v (make-array '(10) :initial-contents '(0 0 0 0 1 2 3 4 5 6)
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (notnot (some #'plusp v))))
(nil nil nil nil nil t t t t t))
(deftest some.18
(loop for i from 1 to 40
for type = `(unsigned-byte ,i)
unless
(let ((v (make-array '(10) :initial-contents (loop for j in '(0 0 0 0 1 2 3 4 5 6)
collect (mod j (ash 1 i)))
:element-type type
:fill-pointer 4)))
(equal (loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (notnot (some #'plusp v)))
'(nil nil nil nil nil t t t t t)))
collect i)
nil)
(deftest some.19
(loop for i from 1 to 40
for type = `(signed-byte ,i)
unless
(let ((v (make-array '(10) :initial-contents '(0 0 0 0 -1 -1 -1 -1 -1 -1)
:element-type type
:fill-pointer 4)))
(equal (loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (notnot (some #'minusp v)))
'(nil nil nil nil nil t t t t t)))
collect i)
nil)
(deftest some.20
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'character
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (notnot (some #'digit-char-p v))))
(nil nil nil nil nil t t t t t))
(deftest some.21
(let ((v (make-array '(10) :initial-contents "abcd012345"
:element-type 'base-char
:fill-pointer 4)))
(loop for j from 0 to 9
do (setf (fill-pointer v) j)
collect (notnot (some #'digit-char-p v))))
(nil nil nil nil nil t t t t t))
(deftest some.22
(let ((v (make-array '(5) :initial-contents "abcde"
:element-type 'base-char)))
(values
(some #'digit-char-p v)
(setf (aref v 2) #\0)
(notnot (some #'digit-char-p v))))
nil #\0 t)
(deftest some.23
(loop for type in '(short-float single-float double-float long-float)
for v = (make-array '(9)
:element-type type
:initial-contents
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6 0 8 3)))
unless (some #'zerop v)
collect (list type v))
nil)
(deftest some.24
(loop for type in '(short-float single-float double-float long-float)
for v = (make-array '(9)
:element-type type
:fill-pointer 6
:initial-contents
(mapcar #'(lambda (x) (coerce x type)) '(1 2 3 4 5 6 0 8 3)))
when (some #'zerop v)
collect (list type v))
nil)
(deftest some.25
(loop for type in '(short-float single-float double-float long-float)
for ctype = `(complex ,type)
for v = (make-array '(6)
:element-type ctype
:initial-contents
(mapcar #'(lambda (x) (complex x (coerce x type))) '(1 2 3 4 5 6)))
when (some (complement #'complexp) v)
collect (list type v))
nil)
;;; Displaced vectors
(deftest some.26
(let* ((v1 (make-array '(10) :initial-contents '(1 3 2 4 6 8 5 7 9 1)))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2)))
(values
(notnot (some #'oddp v1))
(some #'oddp v2)))
t nil)
(deftest some.27
(loop for i from 1 to 40
for type = `(unsigned-byte ,i)
unless
(let* ((v1 (make-array '(10) :initial-contents '(1 1 0 0 0 0 1 1 1 1)
:element-type type))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2
:element-type type)))
(and (some 'oddp v1))
(not (some #'oddp v2)))
collect i)
nil)
(deftest some.28
(loop for i from 1 to 40
for type = `(signed-byte ,i)
unless
(let* ((v1 (make-array '(10) :initial-contents '(-1 -1 0 0 0 0 -1 -1 -1 -1)
:element-type type))
(v2 (make-array '(4) :displaced-to v1
:displaced-index-offset 2
:element-type type)))
(and (some 'oddp v1)
(not (some #'oddp v2))))
collect i)
nil)
(deftest some.29
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'character)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'character
:displaced-to s1
:displaced-index-offset i)
collect (notnot (some 'digit-char-p s2))))
(t t nil nil t t t))
(deftest some.30
(let* ((s1 (make-array '(8) :initial-contents "12abc345" :element-type 'base-char)))
(loop for i from 0 to 6
for s2 = (make-array '(2) :element-type 'base-char
:displaced-to s1
:displaced-index-offset i)
collect (notnot (some 'digit-char-p s2))))
(t t nil nil t t t))
(deftest some.31
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:adjustable t)))
(values
(some #'minusp v)
(progn
(adjust-array v '(11) :initial-element -1)
(notnot (some #'minusp v)))))
nil t)
(deftest some.32
(let ((v (make-array '(10) :initial-contents '(1 2 3 4 5 6 7 8 9 10)
:fill-pointer 10
:adjustable t)))
(values
(some #'minusp v)
(progn
(adjust-array v '(11) :initial-element -1)
(some #'minusp v))))
nil nil)
(deftest some.order.1
(let ((i 0) x y)
(values
...
...
@@ -148,4 +324,7 @@
(signals-error (some #'cons '(a b c) '(b c d) '(c d e)) program-error)