Commit 50dbcc4b authored by pfdietz's avatar pfdietz
Browse files

Added more random type prop tests

parent 8d7f4f37
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Tue Mar 8 20:31:08 2005
;;;; Contains: Random type prop tests, part 5 (Cons)
(in-package :cl-test)
(def-type-prop-test list.1 'list nil 1 :rest-type 't :maxargs 10)
(def-type-prop-test list.2 '(lambda (x) (car (list x))) '(t) 1)
(def-type-prop-test list.3 '(lambda (x y) (cdr (list x y))) '(t t) 2)
(def-type-prop-test list.4 '(lambda (x y z) (cadr (list x y z))) '(t t t) 3)
(def-type-prop-test list.5 '(lambda (x) (let ((z (list x))) (declare (dynamic-extent z)) (car z))) '(t) 1)
(def-type-prop-test list* 'list* () 1 :rest-type t :maxargs 10)
(def-type-prop-test null 'null '(t) 1)
(def-type-prop-test cons.1 'cons '(t t) 2)
(def-type-prop-test cons.2 '(lambda (x y) (car (cons y x))) '(t t) 2)
(def-type-prop-test cons.3 '(lambda (x y) (cdr (cons x y))) '(t t) 2)
(def-type-prop-test consp 'consp '(t) 1)
(def-type-prop-test atom 'atom '(t) 1)
(def-type-prop-test car 'car '((cons t t)) 1)
(def-type-prop-test first 'first '((cons t t)) 1)
(def-type-prop-test cdr 'cdr '((cons t t)) 1)
(def-type-prop-test rest 'rest '((cons t t)) 1)
(def-type-prop-test caar 'caar '((cons (cons t t) t)) 1)
(def-type-prop-test cdar 'cdar '((cons (cons t t) t)) 1)
(def-type-prop-test cadr 'cadr '((cons t (cons t t))) 1)
(def-type-prop-test second 'second '((cons t (cons t t))) 1)
(def-type-prop-test cddr 'cddr '((cons t (cons t t))) 1)
(def-type-prop-test caaar 'caaar '((cons (cons (cons t t) t) t)) 1)
(def-type-prop-test cdaar 'cdaar '((cons (cons (cons t t) t) t)) 1)
(def-type-prop-test cadar 'cadar '((cons (cons t (cons t t)) t)) 1)
(def-type-prop-test cddar 'cddar '((cons (cons t (cons t t)) t)) 1)
(def-type-prop-test caadr 'caadr '((cons t (cons (cons t t) t))) 1)
(def-type-prop-test cdadr 'cdadr '((cons t (cons (cons t t) t))) 1)
(def-type-prop-test caddr 'caddr '((cons t (cons t (cons t t)))) 1)
(def-type-prop-test third 'third '((cons t (cons t (cons t t)))) 1)
(def-type-prop-test cdddr 'cdddr '((cons t (cons t (cons t t)))) 1)
(def-type-prop-test caaaar'caaaar '((cons (cons (cons (cons t t) t) t) t)) 1)
(def-type-prop-test cdaaar 'cdaaar '((cons (cons (cons (cons t t) t) t) t)) 1)
(def-type-prop-test cadaar 'cadaar '((cons (cons (cons t (cons t t)) t) t)) 1)
(def-type-prop-test cddaar 'cddaar '((cons (cons (cons t (cons t t)) t) t)) 1)
(def-type-prop-test caadar 'caadar '((cons (cons t (cons (cons t t) t)) t)) 1)
(def-type-prop-test cdadar 'cdadar '((cons (cons t (cons (cons t t) t)) t)) 1)
(def-type-prop-test caddar 'caddar '((cons (cons t (cons t (cons t t))) t)) 1)
(def-type-prop-test cdddar 'cdddar '((cons (cons t (cons t (cons t t))) t)) 1)
(def-type-prop-test caaadr 'caaadr '((cons t (cons (cons (cons t t) t) t))) 1)
(def-type-prop-test cdaadr 'cdaadr '((cons t (cons (cons (cons t t) t) t))) 1)
(def-type-prop-test cadadr 'cadadr '((cons t (cons (cons t (cons t t)) t))) 1)
(def-type-prop-test cddadr 'cddadr '((cons t (cons (cons t (cons t t)) t))) 1)
(def-type-prop-test caaddr 'caaddr '((cons t (cons t (cons (cons t t) t)))) 1)
(def-type-prop-test cdaddr 'cdaddr '((cons t (cons t (cons (cons t t) t)))) 1)
(def-type-prop-test cadddr 'cadddr '((cons t (cons t (cons t (cons t t))))) 1)
(def-type-prop-test fourth 'fourth '((cons t (cons t (cons t (cons t t))))) 1)
(def-type-prop-test cddddr 'cddddr '((cons t (cons t (cons t (cons t t))))) 1)
(def-type-prop-test fifth 'fifth '((cons t (cons t (cons t (cons t (cons t t)))))) 1)
(def-type-prop-test sixth 'sixth '((cons t (cons t (cons t (cons t (cons t (cons t t))))))) 1)
(def-type-prop-test seventh 'seventh '((cons t (cons t (cons t (cons t (cons t (cons t (cons t t)))))))) 1)
(def-type-prop-test eighth 'eighth
'((cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t t)))))))))
1)
(def-type-prop-test ninth 'ninth
'((cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t t))))))))))
1)
(def-type-prop-test tenth 'tenth
'((cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t (cons t t)))))))))))
1)
(def-type-prop-test copy-tree.1 'copy-tree '((cons t t)) 1)
(def-type-prop-test copy-tree.2 'copy-tree '((cons (cons t t) (cons t t))) 1)
(def-type-prop-test copy-tree.3 'copy-tree '((cons t (cons (cons t (cons t t)) t))) 1)
(def-type-prop-test copy-tree.4 'copy-tree '(list) 1)
(def-type-prop-test sublis.1 'sublis '((cons (cons symbol t) null) list) 2)
(def-type-prop-test sublis.2 'sublis '((cons (cons (integer 0 7) t) null) list) 2)
(def-type-prop-test sublis.3 'sublis '(null list) 2)
(def-type-prop-test sublis.4 'sublis `((cons (cons boolean t) null) list
(eql :key)
(or null (eql not) (eql ,#'not))) 4)
(def-type-prop-test sublis.5 'sublis `((cons (cons t t) null) list (eql :test) (or (eql equal) (eql ,#'equal))) 4)
(def-type-prop-test sublis.6 'sublis `((cons (cons t t) null) list (eql :test-not) (or (eql eql) (eql ,#'eql))) 4)
(def-type-prop-test subst.1 'subst '(t t t) 3)
(def-type-prop-test subst.2 'subst '(t t (cons t t)) 3)
(def-type-prop-test subst.3 'subst '(t t list) 3)
(def-type-prop-test subst.4 'subst '(t t (cons (cons t t) (cons t t))) 3)
(def-type-prop-test subst.5 'subst `(boolean t (cons (cons t t) (cons t t))
(eql :key)
(or null (eql not) (eql ,#'not))) 5)
(def-type-prop-test subst.6 'subst `(t t (cons (cons t t) (cons t t)) (eql :test) (or (eql equal) (eql ,#'equal))) 5)
(def-type-prop-test subst.7 'subst `(t t (cons (cons t t) (cons t t)) (eql :test-not) (or (eql equal) (eql ,#'equal))) 5)
(def-type-prop-test subst.8 'subst `(t t (cons (cons t t) (cons t t))
(eql :key) (or null (eql not) (eql ,#'not))
(eql :test) (or (eql equal) (eql ,#'equal))) 7)
(def-type-prop-test subst-if.1 'subst-if `(t (or (eql not) (eql ,#'not)) list) 3)
(def-type-prop-test subst-if.2 'subst-if `(t (or (eql not) (eql ,#'not)) (cons (or null t) (or null t))) 3)
(def-type-prop-test subst-if.3 'subst-if `(t (eql identity)
(cons (cons (cons t t) (cons t t)) (cons (cons t t) (cons t t)))
(eql :key) (or null (eql not) (eql ,#'not))) 5)
(def-type-prop-test subst-if-not.1 'subst-if-not `(t (or (eql not) (eql ,#'not)) list) 3)
(def-type-prop-test subst-if-not.2 'subst-if-not `(t (or (eql not) (eql ,#'not)) (cons (or null t) (or null t))) 3)
(def-type-prop-test subst-if-not.3 'subst-if-not `(t (eql identity)
(cons (cons (cons t t) (cons t t)) (cons (cons t t) (cons t t)))
(eql :key) (or null (eql not) (eql ,#'not))) 5)
(def-type-prop-test tree-equal.1 'tree-equal (list t #'(lambda (x) `(or t (eql ,(copy-tree x))))) 2)
(def-type-prop-test tree-equal.2 'tree-equal (list 'list #'(lambda (x) `(or list (eql ,(copy-tree t))))) 2)
(def-type-prop-test tree-equal.3 'tree-equal (list '(cons t t)
#'(lambda (x) `(or (cons t t) (eql ,(copy-tree x))))
'(eql :test)
`(or (eql equal) (eql ,#'equal)))
4)
(def-type-prop-test tree-equal.4 'tree-equal (list t #'(lambda (x) `(or t (eql ,(copy-tree x))))
'(eql :test-not) '(eql eql))
4)
(def-type-prop-test copy-list.1 'copy-list '(list) 1)
(def-type-prop-test copy-list.2 'copy-list '((cons t t)) 1)
(def-type-prop-test copy-list.3 'copy-list '((cons t (cons t (or t (cons t (or t (cons t t))))))) 1)
(def-type-prop-test list-length.1 'list-length '(list) 1)
(def-type-prop-test list-length.2 'list-length '((cons t list)) 1)
(def-type-prop-test listp 'listp '(t) 1)
(def-type-prop-test make-list.1 'make-list '((integer 0 100)) 1)
(def-type-prop-test make-list.2 '(lambda (x) (length (make-list x))) '((integer 0 100)) 1)
(def-type-prop-test make-list.3 'make-list '((integer 0 100) (eql :initial-element) t) 3)
(def-type-prop-test nth.1 'nth '((integer 0 12) list) 2)
(def-type-prop-test endp.1 'endp '((or null (cons t t))) 1)
(def-type-prop-test append.1 'append nil 1 :maxargs 10 :rest-type 'list)
(def-type-prop-test append.2 'append '(list t) 2)
(def-type-prop-test append.3 'append '(list list t) 3)
(def-type-prop-test append.4 'append '(list list list t) 4)
(def-type-prop-test nconc.1 'nconc '(list) 1)
(def-type-prop-test nconc.2 '(lambda (x y) (nconc (copy-list x) y)) '(list list) 2)
(def-type-prop-test nconc.3 '(lambda (x y z) (nconc (copy-list x) (copy-list y) z)) '(list list list) 3)
(def-type-prop-test revappend 'revappend '(list t) 2)
(def-type-prop-test nreconc '(lambda (x y) (nreconc (copy-list x) y)) '(list t) 2)
(def-type-prop-test butlast.1 'butlast '(list) 1)
(def-type-prop-test butlast.2 'butlast '(list (integer 0 20)) 2)
(def-type-prop-test nbutlast.1 '(lambda (x) (nbutlast (copy-list x))) '(list) 1)
(def-type-prop-test nbutlast.2 '(lambda (x n) (nbutlast (copy-list x) n)) '(list (integer 0 20)) 2)
(def-type-prop-test last.1 'last '(list) 1)
(def-type-prop-test last.2 'last '(list (integer 0 15)) 2)
(def-type-prop-test last.3 'last '((cons t (or t (cons t (or t (cons t t)))))) 1)
(def-type-prop-test last.4 'last '((cons t (or t (cons t (or t (cons t t))))) (integer 0 5)) 2)
(def-type-prop-test ldiff.1 'ldiff '(list t) 2)
(def-type-prop-test ldiff.2 'ldiff (list 'list
#'(lambda (x)
(if (consp x)
`(or t (eql ,(nthcdr (random (length x)) x)))
t)))
2)
(def-type-prop-test tailp.1 'tailp '(t list) 2)
(def-type-prop-test tailp.2 'tailp (list t #'(lambda (x) (make-list-type (1+ (random 10)) `(eql ,x)))) 2)
(def-type-prop-test nthcdr 'nthcdr '((integer 0 20) list) 2)
(def-type-prop-test member.1 'member '(t list) 2)
(def-type-prop-test member.2 'member
(list t #'(lambda (x) (make-list-type (random 5) `(cons (eql ,x) ,(make-list-type (random 5))))))
2)
(def-type-prop-test member.3 'member `(t list (eql :key) (or (eql not) (eql ,#'not))) 4)
(def-type-prop-test member.4 'member `(t list (eql :test) (or (eql equalp) (eql ,#'equalp))) 4)
(def-type-prop-test member.5 'member `(t list (eql :test-not) (or (eql eql) (eql ,#'eql))) 4)
(def-type-prop-test member.6 'member `(t list (eql :allow-other-keys) (and t (not null)) (eql :foo) t) 6)
(def-type-prop-test member-if.1 'member-if `((or (eql symbolp) (eql ,#'symbolp)) list) 2)
(def-type-prop-test member-if.2 'member-if
(list '(eql zerop) #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10))))
2)
(def-type-prop-test member-if.3 'member-if
(list '(eql zerop) #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10)))
'(eql :key)`(or (eql 1-) (eql ,#'1-)))
4)
(def-type-prop-test member-if-not.1 'member-if-not `((or (eql symbolp) (eql ,#'symbolp)) list) 2)
(def-type-prop-test member-if-not.2 'member-if-not
(list '(eql plusp) #'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10))))
2)
(def-type-prop-test member-if-not.3 'member-if-not
(list '(eql plusp)
#'(lambda (x) (make-list-type (random 10) 'null '(integer 0 10)))
'(eql :key)
`(or (eql 1-) (eql ,#'1-)))
4)
(def-type-prop-test member-if-not.4 'member-if-not
`((eql identity) list
(eql :allow-other-keys) (and t (not null))
(member :foo :bar #:xyz) t)
6)
(def-type-prop-test mapc.1 'mapc '((eql list)) 2 :rest-type 'list :maxargs 10)
(def-type-prop-test mapc.2 'mapc `((eql ,#'values)) 2 :rest-type 'list :maxargs 10)
(def-type-prop-test mapcar.1 'mapcar '((eql list)) 2 :rest-type 'list :maxargs 10)
(def-type-prop-test mapcar.2 'mapcar `((eql ,#'vector)) 2 :rest-type 'list :maxargs 10)
(def-type-prop-test maplist.1 'maplist '((eql list)) 2 :rest-type 'list :maxargs 10)
(def-type-prop-test maplist.2 'maplist `((eql ,#'vector)) 2 :rest-type 'list :maxargs 10)
(def-type-prop-test mapl.1 'mapl '((eql list)) 2 :rest-type 'list :maxargs 10)
(def-type-prop-test mapl.2 'mapl `((eql ,#'vector)) 2 :rest-type 'list :maxargs 10)
(def-type-prop-test acons 'acons
(list t t #'(lambda (x y) (make-list-type (random 5) 'null '(or null (cons t t)))))
3)
(def-type-prop-test assoc.1 'assoc (list t #'(lambda (x) (make-list-type (random 6) 'null '(or null (cons t t))))) 2)
(def-type-prop-test assoc.2 'assoc
(list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons (eql ,x) t)))))
2)
(def-type-prop-test assoc.3 'assoc
(list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons (eql ,x) t))))
'(eql :key) `(or (eql not) (eql ,#'not)))
4)
(def-type-prop-test assoc.4 'assoc
(list 'real
#'(lambda (x) (make-list-type (random 6) 'null `(or null (cons real t) (cons (eql ,x) t))))
`(member :test :test-not) `(member <= < = /= > >= ,#'<= ,#'< ,#'= ,#'/= ,#'> ,#'>=))
4)
(def-type-prop-test assoc-if.1 'assoc-if
(list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
(make-list-type (random 8) 'null '(or null (cons t t))))
2)
(def-type-prop-test assoc-if.2 'assoc-if
(list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
(make-list-type (random 8) 'null '(or null (cons real t)))
'(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
2)
(def-type-prop-test assoc-if-not.1 'assoc-if-not
(list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
(make-list-type (random 8) 'null '(or null (cons t t))))
2)
(def-type-prop-test assoc-if-not.2 'assoc-if-not
(list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
(make-list-type (random 8) 'null '(or null (cons real t)))
'(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
2)
(def-type-prop-test copy-alist 'copy-alist
(list #'(lambda () (make-list-type (random 10) 'null '(or null (cons t t)))))
1)
(def-type-prop-test pairlis.1 'pairlis
(list 'list #'(lambda (x) (make-list-type (length x) 'null t)))
2)
(def-type-prop-test pairlis.2 'pairlis
(list 'list #'(lambda (x) (make-list-type (length x) 'null t))
#'(lambda (x y) (make-list-type (random 6) 'null '(or null (cons t t)))))
3)
(def-type-prop-test rassoc.1 'rassoc (list t #'(lambda (x) (make-list-type (random 6) 'null '(or null (cons t t))))) 2)
(def-type-prop-test rassoc.2 'rassoc
(list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons t (eql ,x))))))
2)
(def-type-prop-test rassoc.3 'rassoc
(list t #'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t t) (cons t (eql ,x)))))
'(eql :key) `(or (eql not) (eql ,#'not)))
4)
(def-type-prop-test rassoc.4 'rassoc
(list 'real
#'(lambda (x) (make-list-type (random 6) 'null `(or null (cons t real) (cons t (eql ,x)))))
`(member :test :test-not) `(member <= < = /= > >= ,#'<= ,#'< ,#'= ,#'/= ,#'> ,#'>=))
4)
(def-type-prop-test rassoc-if.1 'rassoc-if
(list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
(make-list-type (random 8) 'null '(or null (cons t t))))
2)
(def-type-prop-test rassoc-if.2 'rassoc-if
(list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
(make-list-type (random 8) 'null '(or null (cons t real)))
'(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
2)
(def-type-prop-test rassoc-if-not.1 'rassoc-if-not
(list `(member identity not symbolp numberp arrayp ,#'identity ,#'not ,#'symbolp ,#'numberp ,#'arrayp)
(make-list-type (random 8) 'null '(or null (cons t t))))
2)
(def-type-prop-test rassoc-if-not.2 'rassoc-if-not
(list `(member plusp minusp zerop ,#'plusp ,#'minusp ,#'zerop)
(make-list-type (random 8) 'null '(or null (cons t real)))
'(eql :key) `(member 1+ 1- - abs signum ,#'1+ ,#'1- ,#'- ,#'abs ,#'signum))
2)
;;; We don't use numbers or characters as indicators, since the test is EQ,
;;; which is not well-behaved on these types.
(def-type-prop-test get-properties.1 'get-properties
(list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character)))) 'list)
2)
(def-type-prop-test get-properties.2 'get-properties
(list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character))))
#'(lambda (plist) (let ((len (length plist)))
(if (= len 0) '(cons t null)
(let ((ind (elt plist (* 2 (random (floor len 2))))))
`(cons (eql ,ind) null))))))
2)
(def-type-prop-test getf.1 'getf
(list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character)))) t)
2)
(def-type-prop-test getf.2 'getf
(list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character))))
#'(lambda (plist) (let ((len (length plist)))
(if (= len 0) t
(let ((ind (elt plist (* 2 (random (floor len 2))))))
`(eql ,ind))))))
2)
(def-type-prop-test getf.3 'getf
(list #'(lambda () (make-list-type (* 2 (random 5)) 'null '(not (or number character))))
t t)
3)
(def-type-prop-test intersection.1 'intersection '(list list) 2 :test #'same-set-p)
(def-type-prop-test intersection.2 'intersection '(list list (eql :key) (eql identity)) 4 :test #'same-set-p)
(def-type-prop-test intersection.3 'intersection
(list #'(lambda () (make-list-type (random 10) 'null 'integer))
#'(lambda (x) (make-list-type (random 10) 'null 'integer))
'(eql :key)
`(member 1+ ,#'1+))
4
:test #'same-set-p)
(def-type-prop-test intersection.4 'intersection
(list #'(lambda () (make-list-type (random 10) 'null '(cons integer null)))
#'(lambda (x) (make-list-type (random 10) 'null '(cons integer null)))
'(eql :key)
`(member car ,#'car))
4
:test #'(lambda (x y) (same-set-p x y :key #'car)))
(def-type-prop-test intersection.5 'intersection
(list #'(lambda () (make-list-type (random 10) 'null '(cons integer null)))
#'(lambda (x) (make-list-type (random 10) 'null '(cons integer null)))
'(eql :test)
`(member equal ,#'equal))
4
:test #'(lambda (x y) (same-set-p x y :key #'car)))
;;; Others cons-related functions here
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Mar 13 15:33:55 2005
;;;; Contains: Random type prop tests, part 6 (arrays)
(in-package :cl-test)
(def-type-prop-test adjustable-array-p 'adjustable-array-p '(array) 1)
(def-type-prop-test aref.0 'aref '((array * nil)) 1)
(def-type-prop-test aref.1 'aref (list '(array * (*)) (index-type-for-dim 0)) 2)
(def-type-prop-test aref.2 'aref (list '(array * (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
(def-type-prop-test aref.3 'aref (list '(array * (* * *))
(index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
4)
(def-type-prop-test array-dimension 'array-dimension
(list 'array #'(lambda (x) (let ((r (array-rank x))) (and (> r 0) `(integer 0 (,r))))))
2)
(def-type-prop-test array-dimensions 'array-dimensions '(array) 1)
(def-type-prop-test array-element-type 'array-element-type '(array) 1)
(def-type-prop-test array-has-fill-pointer-p.1 'array-has-fill-pointer-p '(array) 1)
(def-type-prop-test array-has-fill-pointer-p.2 'array-has-fill-pointer-p '(vector) 1)
(def-type-prop-test array-displacement.1 'array-displacement '(array) 1)
(def-type-prop-test array-displacement.2 'array-displacement '(vector) 1)
(def-type-prop-test array-in-bounds-p.0 'array-in-bounds-p '((array * nil)) 1)
(def-type-prop-test array-in-bounds-p.1 'array-in-bounds-p (list '(array * (*)) (index-type-for-dim 0)) 2)
(def-type-prop-test array-in-bounds-p.2 'array-in-bounds-p
(list '(array * (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
(def-type-prop-test array-in-bounds-p.3 'array-in-bounds-p
(list '(array * (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
4)
(def-type-prop-test array-in-bounds-p.4 'array-in-bounds-p '((array * (*)) integer) 2)
(def-type-prop-test array-in-bounds-p.5 'array-in-bounds-p '((array * (* *)) integer integer) 3)
(def-type-prop-test array-in-bounds-p.6 'array-in-bounds-p '((array * (* * *)) integer integer integer) 4)
(def-type-prop-test array-rank 'array-rank '(array) 1)
(def-type-prop-test array-row-major-index.0 'array-row-major-index '((array * nil)) 1)
(def-type-prop-test array-row-major-index.1 'array-row-major-index (list '(array * (*)) (index-type-for-dim 0)) 2)
(def-type-prop-test array-row-major-index.2 'array-row-major-index
(list '(array * (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
(def-type-prop-test array-row-major-index.3 'array-row-major-index
(list '(array * (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
4)
(def-type-prop-test array-total-size 'array-total-size '(array) 1)
(def-type-prop-test arrayp 'arrayp '(t) 1)
(def-type-prop-test fill-pointer '(lambda (x) (and (array-has-fill-pointer-p x) (fill-pointer x))) '(vector) 1)
(def-type-prop-test row-major-aref 'row-major-aref
(list 'array #'(lambda (a) (let ((s (array-total-size a))) (and (> s 0) `(integer 0 (,s))))))
2)
(def-type-prop-test upgraded-array-element-type 'upgraded-array-element-type
(list #'(lambda () (let ((x (make-random-element-of-type t)))
`(eql ,(make-random-type-containing x)))))
1)
(def-type-prop-test simple-vector-p.1 'simple-vector-p '(t) 1)
(def-type-prop-test simple-vector-p.2 'simple-vector-p '(vector) 1)
(def-type-prop-test svref 'svref (list 'simple-vector (index-type-for-dim 0)) 2)
(def-type-prop-test vector 'vector nil 1 :rest-type t :maxargs 10)
(def-type-prop-test vectorp.1 'vectorp '(t) 1)
(def-type-prop-test vectorp.2 'vectorp '(array) 1)
(def-type-prop-test bit.1 'bit (list '(array bit (*)) (index-type-for-dim 0)) 2)
(def-type-prop-test bit.2 'bit (list '(array bit (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
(def-type-prop-test bit.3 'bit
(list '(array bit (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
4)
(def-type-prop-test sbit.1 'sbit (list '(simple-array bit (*)) (index-type-for-dim 0)) 2)
(def-type-prop-test sbit.2 'sbit (list '(simple-array bit (* *)) (index-type-for-dim 0) (index-type-for-dim 1)) 3)
(def-type-prop-test sbit.3 'sbit
(list '(simple-array bit (* * *)) (index-type-for-dim 0) (index-type-for-dim 1) (index-type-for-dim 2))
4)
(def-type-prop-test bit-and.1 'bit-and (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
`(array bit ,dims))))
2)
(def-type-prop-test bit-and.2 'bit-and
(list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
3)
(def-type-prop-test bit-andc1.1 'bit-andc1 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
`(array bit ,dims))))
2)
(def-type-prop-test bit-andc1.2 'bit-andc1
(list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
3)
(def-type-prop-test bit-andc2.1 'bit-andc2 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
`(array bit ,dims))))
2)
(def-type-prop-test bit-andc2.2 'bit-andc2
(list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
3)
(def-type-prop-test bit-ior.1 'bit-ior (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
`(array bit ,dims))))
2)
(def-type-prop-test bit-ior.2 'bit-ior
(list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
3)
(def-type-prop-test bit-orc1.1 'bit-orc1 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
`(array bit ,dims))))
2)
(def-type-prop-test bit-orc1.2 'bit-orc1
(list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
3)
(def-type-prop-test bit-orc2.1 'bit-orc2 (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
`(array bit ,dims))))
2)
(def-type-prop-test bit-orc2.2 'bit-orc2
(list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
3)
(def-type-prop-test bit-eqv.1 'bit-eqv (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
`(array bit ,dims))))
2)
(def-type-prop-test bit-eqv.2 'bit-eqv
(list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
3)
(def-type-prop-test bit-xor.1 'bit-xor (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
`(array bit ,dims))))
2)
(def-type-prop-test bit-xor.2 'bit-xor
(list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
3)
(def-type-prop-test bit-nand.1 'bit-nand (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
`(array bit ,dims))))
2)
(def-type-prop-test bit-nand.2 'bit-nand
(list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
3)
(def-type-prop-test bit-nor.1 'bit-nor (list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a)))
`(array bit ,dims))))
2)
(def-type-prop-test bit-nor.2 'bit-nor
(list '(array bit) #'(lambda (a) (let ((dims (array-dimensions a))) `(array bit ,dims))) 'null)
3)
(def-type-prop-test bit-not.1 'bit-not '((array bit)) 1)
(def-type-prop-test bit-not.2 'bit-not '((array bit) null) 2)
(def-type-prop-test bit-vector-p 'bit-vector-p '(t) 1)
(def-type-prop-test simple-bit-vector-p 'simple-bit-vector-p '(t) 1)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Mar 13 17:03:52 2005
;;;; Contains: Random type prop tests, part 7 (strings)
(in-package :cl-test)
(def-type-prop-test simple-string-p 'simple-string-p '(t) 1)
(def-type-prop-test char 'char (list 'string (index-type-for-dim 0)) 2)
(def-type-prop-test schar 'schar (list 'simple-string (index-type-for-dim 0)) 2)
(def-type-prop-test string 'string '((or string symbol character)) 1)
(def-type-prop-test string-upcase 'string-upcase '(string) 1)
(def-type-prop-test string-downcase 'string-downcase '(string) 1)
(def-type-prop-test string-capitalize 'string-capitalize '(string) 1)
(def-type-prop-test string-trim.1 'string-trim '(string string) 2)
(def-type-prop-test string-trim.2 'string-trim (list #'(lambda () (make-list-type (random 10) 'null 'character))
'string)
2)
(def-type-prop-test string-left-trim.1 'string-left-trim '(string string) 2)
(def-type-prop-test string-left-trim.2 'string-left-trim (list #'(lambda () (make-list-type (random 10) 'null 'character))
'string)
2)
(def-type-prop-test string-right-trim.1 'string-right-trim '(string string) 2)
(def-type-prop-test string-right-trim.2 'string-right-trim
(list #'(lambda () (make-list-type (random 10) 'null 'character)) 'string)
2)
(defmacro def-string-comparison-type-prop-test (op)
(flet ((%makename (n) (intern (format nil "~A.~A" op n) :cl-test)))
`(progn
(def-type-prop-test ,(%makename 1) ',op '(string string) 2)
(def-type-prop-test ,(%makename 2) ',op
`(string string (eql :start1) ,#'index-type-for-v1)
4)
(def-type-prop-test ,(%makename 3) ',op
`(string string (eql :start2) ,#'index-type-for-v2)
4)
(def-type-prop-test ,(%makename 4) ',op
`(string string (eql :end1) ,#'end-type-for-v1)
4)
(def-type-prop-test ,(%makename 5) ',op
`(string string (eql :end2) ,#'end-type-for-v2)
4)
(def-type-prop-test ,(%makename 6) ',op
`(string string
(eql :start1) ,#'index-type-for-v1
(eql :end1) ,#'end-type-for-v1)
6)
(def-type-prop-test ,(%makename 7) ',op
`(string string
(eql :start1) ,#'index-type-for-v1
(eql :end2) ,#'end-type-for-v2)
6)
(def-type-prop-test ,(%makename 8) ',op
`(string string
(eql :start2) ,#'index-type-for-v2
(eql :end1) ,#'end-type-for-v1)
6)
(def-type-prop-test ,(%makename 9) ',op
`(string string
(eql :start2) ,#'index-type-for-v2
(eql :end2) ,#'end-type-for-v2)
6)
(def-type-prop-test ,(%makename 10) ',op
`(string string
(eql :start1) ,#'index-type-for-v1
(eql :start2) ,#'index-type-for-v2
(eql :end1) ,#'end-type-for-v1)
8)
(def-type-prop-test ,(%makename 11) ',op
`(string string
(eql :start1) ,#'index-type-for-v1
(eql :start2) ,#'index-type-for-v2
(eql :end2) ,#'end-type-for-v2)
8)
(def-type-prop-test ,(%makename 12) ',op
`(string string
(eql :start1) ,#'index-type-for-v1
(eql :end2) ,#'end-type-for-v2
(eql :end1) ,#'end-type-for-v1)
8)
(def-type-prop-test ,(%makename 13) ',op
`(string string
(eql :start2) ,#'index-type-for-v2
(eql :end2) ,#'end-type-for-v2
(eql :end1) ,#'end-type-for-v1)
8)
(def-type-prop-test ,(%makename 14) ',op
`(string string
(eql :start1) ,#'index-type-for-v1
(eql :start2) ,#'index-type-for-v2
(eql :end2) ,#'end-type-for-v2
(eql :end1) ,#'end-type-for-v1)
10)
)))
(def-string-comparison-type-prop-test string=)
(def-string-comparison-type-prop-test string/=)
(def-string-comparison-type-prop-test string<)
(def-string-comparison-type-prop-test string<=)
(def-string-comparison-type-prop-test string>)
(def-string-comparison-type-prop-test string>=)
(def-string-comparison-type-prop-test string-equal)
(def-string-comparison-type-prop-test string-not-equal)
(def-string-comparison-type-prop-test string-lessp)
(def-string-comparison-type-prop-test string-greaterp)
(def-string-comparison-type-prop-test string-not-lessp)
(def-string-comparison-type-prop-test string-not-greaterp)
(def-type-prop-test stringp 'stringp '(t) 1)
(def-type-prop-test make-string.1 'make-string '((integer 0 100) (eql :initial-element) character) 3)
(def-type-prop-test make-string.2 'make-string `((integer 0 100) (eql :initial-element) character
(eql :element-type)
,#'(lambda (&rest args)
`(eql (and character
,(make-random-type-containing (third args))))))
5)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Mar 13 18:31:57 2005
;;;; Contains: Random type prop tests, part 8 (sequences)