diff --git a/random/random-type-prop-tests-11.lsp b/random/random-type-prop-tests-11.lsp new file mode 100644 index 0000000000000000000000000000000000000000..cd7c668a3ccbae2731a6e49c5905a1afe300f6ea --- /dev/null +++ b/random/random-type-prop-tests-11.lsp @@ -0,0 +1,201 @@ +;-*- 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) + + + + + + + + diff --git a/random/random-type-prop-tests-12.lsp b/random/random-type-prop-tests-12.lsp new file mode 100644 index 0000000000000000000000000000000000000000..e6e6dbb3ecfe81171ec92dff4511352c9f8bc5fc --- /dev/null +++ b/random/random-type-prop-tests-12.lsp @@ -0,0 +1,159 @@ +;-*- 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)) diff --git a/random/random-type-prop-tests-13.lsp b/random/random-type-prop-tests-13.lsp new file mode 100644 index 0000000000000000000000000000000000000000..e2671fdaba2a9610dfcfaa932a7facc8fe830889 --- /dev/null +++ b/random/random-type-prop-tests-13.lsp @@ -0,0 +1,193 @@ +;-*- 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) diff --git a/random/random-type-prop-tests-14.lsp b/random/random-type-prop-tests-14.lsp new file mode 100644 index 0000000000000000000000000000000000000000..e93fc81290cf83684f94a7b5831bc8869d1ad0e1 --- /dev/null +++ b/random/random-type-prop-tests-14.lsp @@ -0,0 +1,39 @@ +;-*- 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) + + + + + + + + diff --git a/random/random-type-prop-tests-15.lsp b/random/random-type-prop-tests-15.lsp new file mode 100644 index 0000000000000000000000000000000000000000..7c8e451cca36220c8f529773c7b157d20efca715 --- /dev/null +++ b/random/random-type-prop-tests-15.lsp @@ -0,0 +1,67 @@ +;-*- 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) + + + diff --git a/random/random-type-prop-tests-16.lsp b/random/random-type-prop-tests-16.lsp new file mode 100644 index 0000000000000000000000000000000000000000..0d66474a257a7099ba51549cd72c19ebdcd35029 --- /dev/null +++ b/random/random-type-prop-tests-16.lsp @@ -0,0 +1,46 @@ +;-*- 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) + + diff --git a/random/random-type-prop-tests-17.lsp b/random/random-type-prop-tests-17.lsp new file mode 100644 index 0000000000000000000000000000000000000000..f9077300598b5c9f8f59d780e5e1da96395a3594 --- /dev/null +++ b/random/random-type-prop-tests-17.lsp @@ -0,0 +1,49 @@ +;-*- 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) + + diff --git a/random/random-type-prop-tests-18.lsp b/random/random-type-prop-tests-18.lsp new file mode 100644 index 0000000000000000000000000000000000000000..43647b0238e1abb5c18845abf73639826923a7fd --- /dev/null +++ b/random/random-type-prop-tests-18.lsp @@ -0,0 +1,352 @@ +;-*- 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) + + + + diff --git a/random/random-type-prop-tests-19.lsp b/random/random-type-prop-tests-19.lsp new file mode 100644 index 0000000000000000000000000000000000000000..d91c940808218d4d3f71d72a0ee33d2994eb7d03 --- /dev/null +++ b/random/random-type-prop-tests-19.lsp @@ -0,0 +1,15 @@ +;-*- 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) diff --git a/run-random-type-tests.lisp b/run-random-type-tests.lisp new file mode 100644 index 0000000000000000000000000000000000000000..df6c4b7e3e076ca06b6ee27e2f746bf88c0c07df --- /dev/null +++ b/run-random-type-tests.lisp @@ -0,0 +1,85 @@ +;;; 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)))) +|# diff --git a/run.lsp b/run.lsp new file mode 100644 index 0000000000000000000000000000000000000000..0b35bb95fc118e25ee62fb80f56818b7e7cf7d80 --- /dev/null +++ b/run.lsp @@ -0,0 +1,10 @@ +;-*- 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"))) +