Skip to content
Snippets Groups Projects
Commit b877a5b9 authored by Karsten Poeck's avatar Karsten Poeck
Browse files

Merge pfdietz take 2

parent efdc9154
No related branches found
No related tags found
No related merge requests found
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Contains: Random type prop tests, part 11 (sequences, cont.)
(in-package :cl-test)
;;; MISMATCH
(def-type-prop-test mismatch.1 'mismatch
(list 'sequence 'sequence)
2)
(def-type-prop-test mismatch.2 'mismatch
(list 'bit-vector 'bit-vector)
2)
(def-type-prop-test mismatch.3 'mismatch
(list '(vector * 1) 'sequence)
2)
(def-type-prop-test mismatch.4 'mismatch
(list '(vector * 2) 'sequence '(eql :from-end) '(or null t))
4)
(def-type-prop-test mismatch.5 'mismatch
(list 'sequence 'sequence '(eql :key)
(list 'member 'identity nil #'identity 'not #'not))
4)
(def-type-prop-test mismatch.6 'mismatch
(list #'(lambda () (make-sequence-type
(random 10)
(let ((i1 (make-random-integer))
(i2 (make-random-integer)))
`(integer ,(min i1 i2) ,(max i1 i2)))))
#'(lambda (s)
(declare (ignore s))
(make-sequence-type
(random 10)
(let ((i1 (make-random-integer))
(i2 (make-random-integer)))
`(integer ,(min i1 i2) ,(max i1 i2))))))
2)
(def-type-prop-test mismatch.7 'mismatch
(list #'(lambda () (make-sequence-type
(random 10)
(let ((i1 (make-random-integer))
(i2 (make-random-integer)))
`(integer ,(min i1 i2) ,(max i1 i2)))))
#'(lambda (s)
(declare (ignore s))
(make-sequence-type
(random 10)
(let ((i1 (make-random-integer))
(i2 (make-random-integer)))
`(integer ,(min i1 i2) ,(max i1 i2)))))
'(eql :test)
(list 'member 'eql #'eql 'equal #'equal '= #'=
'/= #'/= #'(lambda (x y) (= (logand x 1) (logand y 1)))))
4)
(def-type-prop-test mismatch.8 'mismatch
(labels ((%random-char-type () (random-from-seq #(base-char standard-char character)))
(%random-char-sequence-type (&rest ignored)
(declare (ignore ignored))
(make-sequence-type (random 10) (%random-char-type))))
(list #'%random-char-sequence-type
#'%random-char-sequence-type
'(member :test :test-not)
(let ((char-compare-funs
'(char= char/= char< char> char<= char>=
char-equal char-not-equal char-lessp char-greaterp
char-not-lessp char-not-greaterp)))
`(member ,@char-compare-funs
,@(mapcar #'symbol-function char-compare-funs)))))
4)
(def-type-prop-test mismatch.9 'mismatch
(list 'sequence 'sequence
'(eql :start1)
#'(lambda (s1 s2 k)
(declare (ignore s2 k))
(let ((len (length s1)))
`(integer 0 ,len))))
4)
(def-type-prop-test mismatch.10 'mismatch
(list 'sequence 'sequence
'(eql :end1)
#'(lambda (s1 s2 k)
(declare (ignore s2 k))
(let ((len (length s1)))
`(integer 0 ,len))))
4)
(def-type-prop-test mismatch.11 'mismatch
(list 'sequence 'sequence
'(eql :start2)
#'(lambda (s1 s2 k)
(declare (ignore s1 k))
(let ((len (length s2)))
`(integer 0 ,len))))
4)
(def-type-prop-test mismatch.12 'mismatch
(list 'sequence 'sequence
'(eql :end2)
#'(lambda (s1 s2 k)
(declare (ignore s1 k))
(let ((len (length s2)))
`(integer 0 ,len))))
4)
(def-type-prop-test mismatch.13
'(lambda (seq1 seq2 s1) (mismatch seq1 seq2 :start1 s1))
(list 'sequence 'sequence
#'(lambda (seq1 seq2)
(declare (ignore seq2))
`(integer 0 ,(length seq1))))
3)
(def-type-prop-test mismatch.14
'(lambda (seq1 seq2 e1) (mismatch seq1 seq2 :end1 e1))
(list 'sequence 'sequence
#'(lambda (seq1 seq2)
(declare (ignore seq2))
`(or null (integer 0 ,(length seq1)))))
3)
(def-type-prop-test mismatch.15
'(lambda (seq1 seq2 s1 e1) (mismatch seq1 seq2
:start1 s1 :end1 e1))
(list 'sequence 'sequence
#'(lambda (seq1 seq2)
(declare (ignore seq2))
`(integer 0 ,(length seq1)))
#'(lambda (seq1 seq2 s1)
(declare (ignore seq2))
`(or null (integer ,s1 ,(length seq1)))))
4)
(def-type-prop-test mismatch.16
'(lambda (seq1 seq2 s1 e1 s2) (mismatch seq1 seq2
:start1 s1 :end1 e1
:start2 s2))
(list 'sequence 'sequence
#'(lambda (seq1 seq2)
(declare (ignore seq2))
`(integer 0 ,(length seq1)))
#'(lambda (seq1 seq2 s1)
(declare (ignore seq2))
`(or null (integer ,s1 ,(length seq1))))
#'(lambda (seq1 seq2 s1 e1)
(declare (ignore seq1 s1 e1))
`(integer 0 ,(length seq2))))
5)
(def-type-prop-test mismatch.17
'(lambda (seq1 seq2 s1 e1 e2) (mismatch seq1 seq2
:start1 s1 :end1 e1
:end2 e2))
(list 'sequence 'sequence
#'(lambda (seq1 seq2)
(declare (ignore seq2))
`(integer 0 ,(length seq1)))
#'(lambda (seq1 seq2 s1)
(declare (ignore seq2))
`(or null (integer ,s1 ,(length seq1))))
#'(lambda (seq1 seq2 s1 e1)
(declare (ignore seq1 s1 e1))
`(or null (integer 0 ,(length seq2)))))
5)
(def-type-prop-test mismatch.18
'(lambda (seq1 seq2 s1 e1 s2 e2) (mismatch seq1 seq2
:start1 s1 :end1 e1
:start2 s2 :end2 e2))
(list 'sequence 'sequence
#'(lambda (seq1 seq2)
(declare (ignore seq2))
`(integer 0 ,(length seq1)))
#'(lambda (seq1 seq2 s1)
(declare (ignore seq2))
`(or null (integer ,s1 ,(length seq1))))
#'(lambda (seq1 seq2 s1 e1)
(declare (ignore seq1 s1 e1))
`(integer 0 ,(length seq2)))
#'(lambda (seq1 seq2 s1 e1 s2)
(declare (ignore seq1 s1 e1))
`(or null (integer ,s2 ,(length seq2)))))
6)
;-*- Mode: Lisp -*-
(in-package :cl-test)
(def-type-prop-test replace.1 'replace
(list 'list 'list)
2 :replicate '(t nil))
(def-type-prop-test replace.2 'replace
(list 'bit-vector 'bit-vector)
2 :replicate '(t nil))
(def-type-prop-test replace.3 'replace
(list 'list 'bit-vector)
2 :replicate '(t nil))
(def-type-prop-test replace.4 'replace
(list 'string 'base-string)
2 :replicate '(t nil))
(def-type-prop-test replace.4a 'replace
(list '(vector character) 'string)
2 :replicate '(t nil))
(def-type-prop-test replace.5 'replace
(list 'list 'string)
2 :replicate '(t nil))
(def-type-prop-test replace.6 'replace
(list '(vector t) 'vector)
2 :replicate '(t nil))
(def-type-prop-test replace.7 'replace
(list 'list 'vector)
2 :replicate '(t nil))
(def-type-prop-test replace.8 'replace
(list '(vector t) 'list)
2 :replicate '(t nil))
(def-type-prop-test replace.9 'replace
(list '(vector t) 'bit-vector)
2 :replicate '(t nil))
(def-type-prop-test replace.10 'replace
(list '(vector t) 'bit-vector)
2 :replicate '(t nil))
(def-type-prop-test replace.11 'replace
(list '(or list (vector t))
'sequence
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
4 :replicate '(t nil nil nil))
(def-type-prop-test replace.12 'replace
(list 'bit-vector
'bit-vector
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
4 :replicate '(t nil nil nil))
(def-type-prop-test replace.13 'replace
(list 'base-string
'base-string
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
4 :replicate '(t nil nil nil))
(def-type-prop-test replace.14 'replace
(list '(vector character)
'string
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
4 :replicate '(t nil nil nil))
;;
(def-type-prop-test replace.15 'replace
(list '(or list (vector t))
'sequence
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
6 :replicate '(t nil nil nil nil nil))
(def-type-prop-test replace.16 'replace
(list 'bit-vector
'bit-vector
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
6 :replicate '(t nil nil nil nil nil))
(def-type-prop-test replace.17 'replace
(list 'base-string
'base-string
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
6 :replicate '(t nil nil nil nil nil))
(def-type-prop-test replace.18 'replace
(list '(vector character)
'string
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
6 :replicate '(t nil nil nil nil nil))
;;
(def-type-prop-test replace.19 'replace
(list '(or list (vector t))
'sequence
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
8 :replicate '(t nil nil nil nil nil nil nil))
(def-type-prop-test replace.20 'replace
(list 'bit-vector
'bit-vector
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
8 :replicate '(t nil nil nil nil nil nil nil))
(def-type-prop-test replace.21 'replace
(list 'base-string
'base-string
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
8 :replicate '(t nil nil nil nil nil nil nil))
(def-type-prop-test replace.22 'replace
(list '(vector character)
'string
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type
'(member :start1 :start2 :end1 :end2)
#'start-end-type)
8 :replicate '(t nil nil nil nil nil nil nil))
;-*- Mode: Lisp -*-
(in-package :cl-test)
(defmacro if-typep (e x1 x2 x3)
`(typep (if ,e ,x1 ,x2) (type-of ,x3)))
(def-type-prop-test if-typep.1 'if-typep `(t t t t) 4)
(def-type-prop-test typep-typeof.1
'(lambda (x y) (typep x (type-of y)))
'(t t)
2)
(def-type-prop-test typep-class-of.1
'(lambda (x y) (typep x (class-of y)))
'(t t)
2)
(def-type-prop-test +.*.1
'(lambda (x y z) (+ x (* y z)))
'(integer integer integer)
3)
(def-type-prop-test +.*.2
'(lambda (x y z) (+ x (* y z)))
'(rational rational rational)
3)
(def-type-prop-test case.1
'(lambda (c x y z)
(case c (1 x) (2 y) (t z)))
'((or (member 1 2) t)
t t t)
4)
(def-type-prop-test if.+.1
'(lambda (b x y z)
(+ x (if b y z)))
'(t integer integer integer)
4)
(def-type-prop-test if.+.2
'(lambda (b x y z)
(+ (if b y z) x))
'(t integer integer integer)
4)
(def-type-prop-test if.+.3
'(lambda (b x y z)
(+ x (if b y z)))
'(t real real real)
4)
(def-type-prop-test if.+.4
'(lambda (b x y z)
(+ x (if b y z)))
'(t real real real)
4)
(def-type-prop-test concatenate.1
'concatenate
'((eql list) sequence sequence)
3)
(def-type-prop-test concatenate.2
'concatenate
(list '(member string simple-string)
#'(lambda (&rest x) (declare (ignore x)) (make-sequence-type (random 10) 'character))
#'(lambda (&rest x) (declare (ignore x)) (make-sequence-type (random 10) 'character)))
3)
(def-type-prop-test concatenate.3
'concatenate
(list '(member base-string simple-base-string)
#'(lambda (&rest x) (declare (ignore x)) (make-sequence-type (random 10) 'base-char))
#'(lambda (&rest x) (declare (ignore x)) (make-sequence-type (random 10) 'base-char)))
3)
(def-type-prop-test concatenate.4
'concatenate
'((eql vector) sequence sequence)
3)
(def-type-prop-test concatenate.5
'concatenate
(list '(member bit-vector simple-bit-vector)
#'(lambda (&rest x) (declare (ignore x)) (make-sequence-type (random 10) 'bit))
#'(lambda (&rest x) (declare (ignore x)) (make-sequence-type (random 10) 'bit)))
3)
(def-type-prop-test remove.1
'remove
(list t #'make-random-sequence-type-containing)
2)
(def-type-prop-test remove.2
'remove
(list t #'make-random-sequence-type-containing '(eql :from-end) '(member nil t))
4)
(def-type-prop-test remove.3
'remove
(list 'bit 'bit-vector)
2)
(def-type-prop-test remove.4
'remove
(list 'bit 'simple-bit-vector)
2)
(def-type-prop-test remove.5
'remove
(list 'character 'string)
2)
(def-type-prop-test remove.6
'remove
(list 'character 'simple-string)
2)
(def-type-prop-test remove.7
'remove
(list t #'make-random-sequence-type-containing
'(eql :start) #'start-type-for-v2)
4)
(def-type-prop-test remove.8
'remove
(list t #'make-random-sequence-type-containing
'(eql :end) #'start-type-for-v2)
4)
(def-type-prop-test remove.9
'remove
(list t #'make-random-sequence-type-containing
'(eql :start) #'start-type-for-v2
'(eql :end) #'(lambda (v1 v2 sk si ek) (declare (ignore v1 sk ek))
`(integer ,si ,(length v2))))
6)
(def-type-prop-test remove.10
'remove
(list t #'make-random-sequence-type-containing
'(eql :count) '(integer 0 3))
4)
(def-type-prop-test remove.10a
'remove
(list t #'make-random-sequence-type-containing
'(eql :count) 'integer)
4)
(def-type-prop-test remove.11
'remove
(list t #'make-random-sequence-type-containing
'(eql :start) #'start-type-for-v2
'(eql :count) '(integer 0 3))
6)
(def-type-prop-test remove.12
'remove
(list t #'make-random-sequence-type-containing
'(eql :start) #'start-type-for-v2
'(eql :end) #'(lambda (v1 v2 sk si ek) (declare (ignore v1 sk ek))
`(integer ,si ,(length v2)))
'(eql :count) '(integer 0 3))
8)
(def-type-prop-test remove.13
'remove
(list t #'make-random-sequence-type-containing
'(eql :count) '(integer 0 3)
'(eql :from-end) '(eql t))
6)
(def-type-prop-test remove.14
'remove
(list t #'make-random-sequence-type-containing
'(eql :start) #'start-type-for-v2
'(eql :count) '(integer 0 3)
'(eql :from-end) '(eql t))
8)
(def-type-prop-test remove.15
'remove
(list t #'make-random-sequence-type-containing
'(eql :start) #'start-type-for-v2
'(eql :end) #'(lambda (v1 v2 sk si ek) (declare (ignore v1 sk ek))
`(integer ,si ,(length v2)))
'(eql :count) '(integer 0 3)
'(eql :from-end) '(eql t))
10)
;-*- Mode: Lisp -*-
(in-package :cl-test)
(def-type-prop-test coerce.1 '(lambda (x) (coerce x 'sequence))
'(sequence)
1)
(def-type-prop-test coerce.2 '(lambda (x) (coerce x 'vector))
'(sequence)
1)
(def-type-prop-test coerce.3 '(lambda (x) (coerce x 'character))
'(character)
1)
(def-type-prop-test coerce.4 '(lambda (x) (coerce (string x) 'character))
'(character)
1)
(def-type-prop-test coerce.5 '(lambda (x) (coerce (make-symbol (string x)) 'character))
'(character)
1)
(def-type-prop-test coerce.6 '(lambda (x) (coerce x 'complex))
'(number)
1)
(def-type-prop-test coerce.7 'coerce
'(t (eql t))
2)
;-*- Mode: Lisp -*-
(in-package :cl-test)
(def-type-prop-test make-hash-table.1 '(lambda (x) (make-hash-table :test x))
`((member eq eql equal equalp ,#'eq ,#'eql ,#'equal ,#'equalp))
1
:test #'equalp)
(def-type-prop-test make-hash-table.2 '(lambda (x) (make-hash-table :size x))
'((integer 0 100000))
1
:test #'equalp)
(def-type-prop-test make-hash-table.3 '(lambda (x y)
(let ((h (make-hash-table)))
(setf (gethash x h) y)
h))
'(t t)
2
:test #'equalp)
(def-type-prop-test make-hash-table.4 '(lambda (x y z w)
(let ((h (make-hash-table)))
(setf (gethash x h) y)
(setf (gethash z h) w)
h))
'(t t t t)
4
:test #'equalp)
(def-type-prop-test make-hash-table.5 '(lambda (x y z w tst)
(let ((h (make-hash-table :test tst)))
(setf (gethash x h) y)
(setf (gethash z h) w)
h))
`(t t t t
(member eql equal equalp ,#'eql ,#'equal ,#'equalp))
5
:test #'equalp)
(def-type-prop-test make-hash-table.6 '(lambda (x y z w s)
(let ((h (make-hash-table :size s)))
(setf (gethash x h) y)
(setf (gethash z h) w)
h))
`(t t t t
(integer 0 10000))
5
:test #'equalp)
;;; Must test EQ hash tables separately, because they can misbehave
;;; on number or character keys due to possibility of copying
(def-type-prop-test make-hash-table.7 '(lambda (x y z w tst)
(let ((h (make-hash-table :test tst)))
(setf (gethash x h) y)
(setf (gethash z h) w)
h))
`((not (or number character)) t (not (or number character)) t
(member eq ,#'eq))
5
:test #'equalp)
(def-type-prop-test hash-table-p.1 'hash-table-p '(t) 1)
;-*- Mode: Lisp -*-
(in-package :cl-test)
(def-type-prop-test remove-duplicates.1 'remove-duplicates '(sequence) 1)
(def-type-prop-test remove-duplicates.2 'remove-duplicates '(list) 1)
(def-type-prop-test remove-duplicates.3
'remove-duplicates
'(sequence (eql :from-end) (member nil t))
3)
(def-type-prop-test remove-duplicates.4
'remove-duplicates
'(sequence (eql :test) (member eql equal equalp))
3)
(def-type-prop-test remove-duplicates.5
'remove-duplicates
'(sequence (eql :test-not) (member eql equal equalp))
3)
(def-type-prop-test remove-duplicates.6
'remove-duplicates
'(sequence (member :test :test-not) (member eql equal equalp)
(eql :from-end) (member nil t))
5)
(def-type-prop-test remove-duplicates.7
'remove-duplicates
'(bit-vector (eql :key) (member 1+ 1- - #.#'1- #.#'1- #.#'-))
3)
(def-type-prop-test remove-duplicates.8
'remove-duplicates
(list 'sequence
'(eql :start) #'start-type-for-v)
3)
(def-type-prop-test remove-duplicates.9
'remove-duplicates
(list 'sequence
'(eql :end) #'end-type-for-v)
3)
(def-type-prop-test remove-duplicates.10
'remove-duplicates
(list 'sequence
'(eql :start) #'start-type-for-v
'(eql :end) #'end-type-for-v)
5)
;-*- Mode: Lisp -*-
(in-package :cl-test)
(def-type-prop-test nth-value.1
'nth-value
(list `(integer 0 (,multiple-values-limit)) t)
2)
(def-type-prop-test nth-value.2
'nth-value
(list '(integer 0 (32)) t)
2)
(def-type-prop-test nth-value.3
'(lambda (i x) (nth-value i (apply #'values x)))
(list '(integer 0 (32)) 'list)
2)
(def-type-prop-test nth-value.4
'(lambda (i x) (nth-value i (apply #'values x)))
(list '(integer 0 (64)) 'list)
2)
(def-type-prop-test nth-value.5
'(lambda (i x y z) (nth-value i (values x y z)))
(list `(or (integer 0 (5)) (integer 0 (,multiple-values-limit))) t t t)
4)
(def-type-prop-test funcall.1
'funcall
(list `(member ,@(loop for x in '(+ * - 1+ 1- = /=)
append (list x (symbol-function x))))
'number)
2)
(def-type-prop-test funcall.2
'funcall
(list `(member ,@(loop for x in '(+ * - = /=) append (list x (symbol-function x))))
'number
'number)
3)
(def-type-prop-test funcall.3
'(lambda (x) (funcall (constantly x)))
(list t)
1)
;-*- Mode: Lisp -*-
(in-package :cl-test)
(def-type-prop-test substitute.1
'substitute
(list t t '(vector t))
3)
(def-type-prop-test substitute.2
'substitute
(list 'base-char 'base-char 'base-string)
3)
(def-type-prop-test substitute.3
'substitute
(list 'character 'character '(vector character))
3)
(def-type-prop-test substitute.4
'substitute
(list t t '(vector t) '(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.5
'substitute
(list 'base-char 'base-char 'base-string '(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.6
'substitute
(list 'bit 'bit 'bit-vector)
3)
(def-type-prop-test substitute.7
'substitute
(list 'bit 'bit 'bit-vector '(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.8
'substitute
(list '(integer 0 3) '(integer 0 3) '(vector (integer 0 3)))
3)
(def-type-prop-test substitute.9
'substitute
(list '(integer 0 3) '(integer 0 3) '(vector (integer 0 3))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.10
'substitute
(list '(integer 0 7) '(integer 0 7) '(vector (integer 0 7)))
3)
(def-type-prop-test substitute.11
'substitute
(list '(integer 0 15) '(integer 0 15) '(vector (integer 0 15)))
3)
(def-type-prop-test substitute.12
'substitute
(list '(integer 0 15) '(integer 0 15) '(vector (integer 0 15))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.13
'substitute
(list '(unsigned-byte 8) '(unsigned-byte 8) '(vector (unsigned-byte 8)))
3)
(def-type-prop-test substitute.14
'substitute
(list '(unsigned-byte 8) '(unsigned-byte 8) '(vector (unsigned-byte 8))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.15
'substitute
(list '(signed-byte 8) '(signed-byte 8) '(vector (signed-byte 8)))
3)
(def-type-prop-test substitute.16
'substitute
(list '(signed-byte 8) '(signed-byte 8) '(vector (signed-byte 8))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.17
'substitute
(list '(unsigned-byte 7) '(unsigned-byte 7) '(vector (unsigned-byte 7)))
3)
(def-type-prop-test substitute.18
'substitute
(list '(unsigned-byte 7) '(unsigned-byte 7) '(vector (unsigned-byte 7))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.19
'substitute
(list '(unsigned-byte 16) '(unsigned-byte 16) '(vector (unsigned-byte 16)))
3)
(def-type-prop-test substitute.20
'substitute
(list '(unsigned-byte 16) '(unsigned-byte 16) '(vector (unsigned-byte 16))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.21
'substitute
(list '(signed-byte 16) '(signed-byte 16) '(vector (signed-byte 16)))
3)
(def-type-prop-test substitute.22
'substitute
(list '(signed-byte 16) '(signed-byte 16) '(vector (signed-byte 16))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.23
'substitute
(list '(unsigned-byte 15) '(unsigned-byte 15) '(vector (unsigned-byte 15)))
3)
(def-type-prop-test substitute.24
'substitute
(list '(unsigned-byte 15) '(unsigned-byte 15) '(vector (unsigned-byte 15))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.25
'substitute
(list '(unsigned-byte 32) '(unsigned-byte 32) '(vector (unsigned-byte 32)))
3)
(def-type-prop-test substitute.26
'substitute
(list '(unsigned-byte 32) '(unsigned-byte 32) '(vector (unsigned-byte 32))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.27
'substitute
(list '(signed-byte 32) '(signed-byte 32) '(vector (signed-byte 32)))
3)
(def-type-prop-test substitute.28
'substitute
(list '(signed-byte 32) '(signed-byte 32) '(vector (signed-byte 32))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.29
'substitute
(list '(unsigned-byte 31) '(unsigned-byte 31) '(vector (unsigned-byte 31)))
3)
(def-type-prop-test substitute.30
'substitute
(list '(unsigned-byte 31) '(unsigned-byte 31) '(vector (unsigned-byte 31))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.31
'substitute
(list t t 'list)
3)
(def-type-prop-test substitute.32
'substitute
(list t t '(cons t (cons t (cons t (cons t (cons t (cons t null)))))))
3)
(def-type-prop-test substitute.33
'substitute
(list '(unsigned-byte 3) '(unsigned-byte 3) '(cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null)))))))
3)
(def-type-prop-test substitute.34
'substitute
(list '(unsigned-byte 3) '(unsigned-byte 3) '(cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))))
'(eql :count) '(integer 0 4))
5)
(def-type-prop-test substitute.35
'substitute
(list '(unsigned-byte 3) '(unsigned-byte 3) '(cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))))
'(eql :key) `(member 1+ 1- ,#'1+ ,#'1-))
5)
(def-type-prop-test substitute.36
'substitute
(list '(unsigned-byte 3) '(unsigned-byte 3) '(cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))))
'(member :test :test-not)
`(member eq eql = equal equalp
,#'eq ,#'eql ,#'= ,#'equal ,#'equalp))
5)
(def-type-prop-test substitute.37
'substitute
(list '(unsigned-byte 3) '(unsigned-byte 3) '(cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))))
'(eql :key) `(member 1+ 1- ,#'1+ ,#'1- nil)
'(member :test :test-not)
`(member eq eql = equal equalp
,#'eq ,#'eql ,#'= ,#'equal ,#'equalp))
7)
(def-type-prop-test substitute.38
'substitute
(list '(unsigned-byte 3) '(unsigned-byte 3) '(cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))))
'(eql :key) `(member 1+ 1- ,#'1+ ,#'1-)
'(member :test :test-not)
`(member eq eql = equal equalp
,#'eq ,#'eql ,#'= ,#'equal ,#'equalp)
`(eql :key) `(eql ,#'(lambda (x) (error "Bad: ~A" x))))
9)
(def-type-prop-test substitute.39
'substitute
(list '(unsigned-byte 3) '(unsigned-byte 3) '(cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))))
'(member :test :test-not)
`(member eq eql = equal equalp
,#'eq ,#'eql ,#'= ,#'equal ,#'equalp)
'(eql :count) '(integer 0 4))
7)
(def-type-prop-test substitute.40
'substitute
(list '(unsigned-byte 3) '(unsigned-byte 3) '(cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) (cons (unsigned-byte 3) null))))))
'(member :test :test-not)
`(member eq eql = equal equalp
,#'eq ,#'eql ,#'= ,#'equal ,#'equalp)
'(eql :key) `(member 1+ 1- ,#'1+ ,#'1-)
'(eql :count) '(integer 0 4))
7)
(def-type-prop-test substitute.41
'substitute
(list 'integer 'integer
(lambda (x y) `(vector (integer ,(min x y) ,(max x y)))))
3)
(def-type-prop-test substitute.42
'substitute
(list '(eql 0) '(eql 1)
#'make-random-sequence-type-containing
'(eql :from-end) '(member t nil))
5)
(def-type-prop-test substitute.43
'substitute
(list '(eql 0) '(eql 1)
#'make-random-sequence-type-containing
'(eql :from-end) '(member t nil)
'(eql :count) '(integer 0 4))
7)
(def-type-prop-test substitute.44
'substitute
(list '(eql 0) '(eql 1)
#'make-random-sequence-type-containing
'(eql :start) (lambda (e1 e2 s k) (declare (ignore e1 e2 k))
`(integer 0 ,(length s))))
5)
(def-type-prop-test substitute.45
'substitute
(list '(eql 0) '(eql 1)
#'make-random-sequence-type-containing
'(eql :end) (lambda (e1 e2 s k) (declare (ignore e1 e2 k))
`(integer 0 ,(length s))))
5)
(def-type-prop-test substitute.46
'substitute
(list '(eql 0) '(eql 1)
#'make-random-sequence-type-containing
'(eql :start) (lambda (e1 e2 s k) (declare (ignore e1 e2 k))
`(integer 0 ,(length s)))
'(eql :end) (lambda (e1 e2 s k1 p1 k2) (declare (ignore e1 e2 k1 k2))
`(integer ,p1 ,(length s))))
7)
(def-type-prop-test substitute.47
'substitute
(list '(eql 0) '(eql 1)
#'make-random-sequence-type-containing
'(eql :start) (lambda (e1 e2 s k) (declare (ignore e1 e2 k))
`(integer 0 ,(length s)))
'(eql :from-end) '(member t nil))
7)
(def-type-prop-test substitute.48
'substitute
(list '(eql 0) '(eql 1)
#'make-random-sequence-type-containing
'(eql :end) (lambda (e1 e2 s k) (declare (ignore e1 e2 k))
`(integer 0 ,(length s)))
'(eql :from-end) '(member t nil))
7)
(def-type-prop-test substitute.49
'substitute
(list '(eql 0) '(eql 1)
#'make-random-sequence-type-containing
'(eql :start) (lambda (e1 e2 s k) (declare (ignore e1 e2 k))
`(integer 0 ,(length s)))
'(eql :end) (lambda (e1 e2 s k1 p1 k2) (declare (ignore e1 e2 k1 k2))
`(integer ,p1 ,(length s)))
'(eql :from-end) '(member t nil))
9)
(def-type-prop-test substitute.50
'substitute
(list '(eql #\a) '(eql #\b)
#'make-random-sequence-type-containing
'(eql :start) (lambda (e1 e2 s k) (declare (ignore e1 e2 k))
`(integer 0 ,(length s)))
'(eql :end) (lambda (e1 e2 s k1 p1 k2) (declare (ignore e1 e2 k1 k2))
`(integer ,p1 ,(length s)))
'(eql :from-end) '(member t nil))
9)
(def-type-prop-test substitute.51
'substitute
(list t t
#'make-random-sequence-type-containing
'(eql :start) (lambda (e1 e2 s k) (declare (ignore e1 e2 k))
`(integer 0 ,(length s)))
'(eql :end) (lambda (e1 e2 s k1 p1 k2) (declare (ignore e1 e2 k1 k2))
`(integer ,p1 ,(length s)))
'(eql :from-end) '(member t nil))
9)
(def-type-prop-test substitute.52
'substitute
(list t t
#'make-random-sequence-type-containing
'(eql :start) (lambda (e1 e2 s k) (declare (ignore e1 e2 k))
`(integer 0 ,(length s)))
'(eql :end) (lambda (e1 e2 s k1 p1 k2) (declare (ignore e1 e2 k1 k2))
`(integer ,p1 ,(length s)))
'(eql :from-end) '(member t nil)
'(eql :count) '(integer 0 4))
9)
;-*- Mode: Lisp -*-
(in-package :cl-test)
(def-type-prop-test sin.1 'sin '(real) 1)
(def-type-prop-test sin.2 'sin '(single-float) 1)
(def-type-prop-test sin.3 'sin '(double-float) 1)
(def-type-prop-test sin.4 'sin '(long-float) 1)
(def-type-prop-test sin.5 'sin '(short-float) 1)
(def-type-prop-test cos.1 'cos '(real) 1)
(def-type-prop-test cos.2 'cos '(single-float) 1)
(def-type-prop-test cos.3 'cos '(double-float) 1)
(def-type-prop-test cos.4 'cos '(long-float) 1)
(def-type-prop-test cos.5 'cos '(short-float) 1)
(def-type-prop-test tan.1 'tan '((real (#.(- (/ pi 2))) (#.(/ pi 2)))) 1)
;;; from https://bugs.launchpad.net/sbcl/+bug/1916233
#|
1) Get ansi-test from https://github.com/pfdietz/ansi-test
|#
#|
2) in the root directory start your lisp and execute
in my system: /Users/karstenpoeck/lisp/pfdietz-ansi-test
Clasp
(ext:chdir "/Users/karstenpoeck/lisp/pfdietz-ansi-test")
|#
(eval-when (:load-toplevel :compile-toplevel :execute)
(declaim (optimize (safety 3)(speed 0)(debug 3))))
(let ((wd (or *compile-file-pathname* *load-pathname*)))
(when wd
(setf *default-pathname-defaults*
(make-pathname :name nil :type nil :version nil :defaults wd))))
;;; Remove compiled files
(let* ((fn (compile-file-pathname "doit.lsp"))
(type (pathname-type fn))
(dir-pathname (make-pathname :name :wild :type type))
(subdir-pathname (make-pathname :directory '(:relative :wild)
:name :wild :type type))
(format-pathname (make-pathname :directory '(:relative "printer" "format")
:name :wild :type type))
(files (append (directory dir-pathname)
(directory subdir-pathname)
(directory format-pathname))))
(mapc #'(lambda(file)
(assert (not (string-equal (pathname-type file) "lsp")))
(format t "Cleaning binary file ~a~%" file)
(delete-file file))
files))
(with-compilation-unit ()
(load "run.lsp")
(load (compile-file "auxiliary/types-aux.lsp"))
(load (compile-file "auxiliary/random-aux.lsp"))
(load (compile-file "random/random-types.lsp")))
#|
3) In the package CL-TEST, execute test-mutated-types
If the result is nonempty, it will be a list of type pairs on which a property failed.
Simplify the pairs
test-types shows the error for every pair
|#
(in-package :cl-test)
(let ((*random-state* (make-random-state t)))
(handler-bind ((style-warning #'muffle-warning))
(test-random-integer-forms 4 4 10000)))
#+no
(let ((failures (test-random-mutated-types 30000 10 :reps 2)))
(when failures
(mapcar #'prune-type-pair failures)))
#|
4) Additional testing can be done with test-types and test-type-triples. The latter has its own pruner, prune-type-triple.
(let ((failures (test-random-types 30000 10)))
(when failures
(mapcar #'prune-type-pair failures)))
(let ((failures (test-random-types3 30000 10)))
(when failures
(mapcar #'prune-type-triple failures)))
Bonus: The well known random tester
(let ((*random-state* (make-random-state t)))
(handler-bind ((style-warning #'muffle-warning))
(test-random-integer-forms 10 4 10000)))
(time
(let ((*random-state* (make-random-state t)))
(handler-bind ((style-warning #'muffle-warning))
(cl-test::test-random-integer-forms 30 4 10000))))
|#
run.lsp 0 → 100644
;-*- Mode: Lisp -*-
(load "gclload1.lsp")
(pushnew :mutation *features*)
(compile-and-load "random/random-int-form.lsp")
(compile-and-load "random/random-type-prop.lsp")
#+sbcl (compile-and-load "random/mutate.lsp")
(load "random/random-type-prop-tests.lsp")
(funcall (symbol-function (intern "INIT-RANDOM-STATE" "CL-TEST")))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment