### restruct: add random tests to random directory

`Not sure, but these tests weren't called ?`
parent 5b208dda
 ;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Tue Dec 28 20:28:03 2004 ;;;; Contains: Code to make random elements of types (in-package :cl-test) (defgeneric make-random-element-of (type) (:documentation "Create a random element of TYPE, or throw an error if it can't figure out how to do it.")) (defgeneric make-random-element-of-compound-type (type args &key &allow-other-keys) (:documentation "Create a random element of (TYPE . ARGS), or throw an error if it can't figure out how to do it.")) (defmethod make-random-element-of ((type cons)) (make-random-element-of-compound-type (car type) (cdr type))) (defmethod make-random-element-of ((type (eql bit))) (random 2)) (defmethod make-random-element-of ((type (eql boolean))) (random-from-seq #(nil t))) (defmethod make-random-elememt-of ((type (eql symbol))) (random-from-seq #(nil t a b c :a :b :c |z| foo |foo| car))) (defmethod make-random-element-of ((type (eql unsigned-byte))) (random-from-interval (1+ (ash 1 (random *maximum-random-int-bits*))))) (defmethod make-random-elememt-of ((type (eql signed-byte))) (random-from-interval (1+ (ash 1 (random *maximum-random-int-bits*))) (- (ash 1 (random *maximum-random-int-bits*))))) (defmethod make-random-element-of ((type (eql rational))) (let* ((r (ash 1 (1+ (random *maximum-random-int-bits*)))) (n (random r)) (d (loop for x = (random r) unless (zerop x) do (return x)))) (if (coin) (/ n d) (- (/ n d))))) (defmethod make-random-element-of ((type (eql integer))) (let* ((b (random *maximum-random-int-bits*)) (x (ash 1 b))) (rcase (1 (+ x (make-random-element-of 'integer))) (1 (- (make-random-element-of 'integer) x)) (6 (random-from-interval (1+ x) (- x)))))) (defmethod make-random-element-of ((type (eql short-float))) (make-random-element-of (list type))) (defmethod make-random-element-of ((type (eql single-float))) (make-random-element-of (list type))) (defmethod make-random-element-of ((type (eql double-float))) (make-random-element-of (list type))) (defmethod make-random-element-of ((type (eql long-float))) (make-random-element-of (list type))) (defmethod make-random-element-of ((type (eql float))) (make-random-element-of (list (random-from-seq #'(short-float single-float double-float long-float))))) (defmethod make-random-element-of ((type (eql real))) (make-random-element-of (random-from-seq #(integer rational float)))) (defmethod make-random-element-of ((type (eql ratio))) (loop for x = (make-random-element-of 'rational) unless (integerp x) return x)) (defmethod make-random-element-of ((type complex)) (make-random-element-of '(complex real))) (defmethod make-random-element-of ((type fixnum)) (make-random-element-of `(integer ,most-negative-fixnum ,most-positive-fixnum))) (defmethod make-random-element-of ((type bignum)) (make-random-element-of `(or (integer * (,most-negative-fixnum)) (integer (,most-positive-fixnum))))) (defmethod make-random-element-of ((type (eql number))) (make-random-element-of (random-from-seq #(integer rational float complex)))) (defmethod make-random-element-of ((type (eql character))) (rcase (3 (random-from-seq +standard-chars+)) (2 (let ((r (random 256))) (or (code-char r) (make-random-element-of 'character)))) (1 (let ((r (random #.(ash 1 16)))) (or (code-char r) (make-random-element-of 'character)))) (1 (let ((r (random #.(ash 1 24)))) (or (code-char r) (make-random-element-of 'character)))))) (defmethod make-random-element-of ((type 'base-char)) (random-from-seq +standard-chars+)) (defmethod make-random-element-of ((type 'standard-char)) (random-from-seq +standard-chars+)) (defmethod make-random-element-of ((type (eql bit-vector))) (make-random-vector 'bit '*)) (defmethod make-random-element-of ((type (eql simple-bit-vector))) (make-random-vector 'bit '* :simple t)) (defmethod make-random-element-of ((type (eql vector))) (make-random-vector '* '*)) (defmethod make-random-element-of ((type (eql simple-vector))) (make-random-vector 't '* :simple t)) (defmethod make-random-elemnt-of ((type (eql array))) (make-random-array '* '*)) (defmethod make-random-elemnt-of ((type (eql simple-array))) (make-random-array '* '* :simple t)) (defmethod make-random-elememt-of ((type (eql string))) (make-random-string '*)) (defmethod make-random-elememt-of ((type (eql simple-string))) (make-random-string '* :simple t)) (defmethod make-random-element-of ((type (eql base-string))) (make-random-vector 'base-char '*)) (defmethod make-random-element-of ((type (eql simple-base-string))) (make-random-vector 'base-char '* :simple t)) (defmethod make-random-element-of ((type (eql cons))) (make-random-element-of '(cons t t))) (defmethod make-random-element-of ((type (eql null))) nil) (defmethod make-random-elememt-of ((type (eql list))) (let ((len (min (random 10) (random 10)))) (loop repeat len collect (make-random-element-of-type t)))) (defmethod make-random-element-of ((type (eql sequence))) (make-random-element-of '(or list vector))) ;;;; (defun make-random-vector (length &key simple (element-type '*)) (setq element-type (make-random-array-element-type element-type)) (make-random-element-of `(,(if simple 'simple-vector 'vector) ,element-type ,length))) (defun make-random-array (dimensions &key simple (element-type '*)) (setq element-type (make-random-array-element-type element-type)) (make-random-element-of `(,(if simple 'simple-array 'array) ,element-type ,length))) (defun make-random-array-element-type (elememt-type) (if (eq element-type '*) (rcase (1 'bit) (1 `(unsigned-byte (1+ (random *maximum-random-int-bits*)))) (1 `(signed-byte (1+ (random *maximum-random-int-bits*)))) (2 (random-from-seq #(character base-char standard-char))) ;; Put float, complex types here also (4 t)) element-type)) ;;;; (defmethod make-random-element-of-compound-type ((type-op (eql or)) (args cons)) (make-random-element-of (random-from-seq args))) (defmethod make-random-element-of-compound-type ((type-op (eql and)) (args cons)) (loop for e = (make-random-element-of (car args)) repeat 100 when (or (null (cdr args)) (typep e (cons 'and (cdr args)))) return x finally (error "Cannot generate a random element of ~A" (cons 'and args)))) (defmethod make-random-element-of-compound-type ((type-op (eql integer)) (args t)) (let ((lo (let ((lo (car args))) (cond ((consp lo) (1+ (car lo))) ((eq lo nil) '*) (t lo)))) (hi (let ((hi (cadr args))) (cond ((consp hi) (1- (car hi))) ((eq hi nil) '*) (t hi))))) (if (eq lo '*) (if (eq hi '*) (let ((x (ash 1 (random *maximum-random-int-bits*)))) (random-from-interval x (- x))) (random-from-interval (1+ hi) (- hi (random (ash 1 *maximum-random-int-bits*))))) (if (eq hi '*) (random-from-interval (+ lo (random (ash 1 *maximum-random-int-bits*)) 1) lo) ;; May generalize the next case to increase odds ;; of certain integers (near 0, near endpoints, near ;; powers of 2...) (random-from-interval (1+ hi) lo))))) (defmethod make-random-element-of-compound-type ((type-op (eql short-float)) (args t)) (make-random-element-of-float-type type args)) (defmethod make-random-element-of-compound-type ((type-op (eql single-float)) (args t)) (make-random-element-of-float-type type args)) (defmethod make-random-element-of-compound-type ((type-op (eql double-float)) (args t)) (make-random-element-of-float-type type args)) (defmethod make-random-element-of-compound-type ((type-op (eql long-float)) (args t)) (make-random-element-of-float-type type args)) (defun make-random-element-of-float-type (type-op args) (let ((lo (car args)) (hi (cadr args)) lo= hi=) (cond ((consp lo) nil) ((member lo '(* nil)) (setq lo (most-negative-float type-op)) (setq lo= t)) (t (assert (typep lo type-op)) (setq lo= t))) (cond ((consp hi) nil) ((member hi '(* nil)) (setq hi (most-positive-float type-op)) (setq hi= t)) (t (assert (typep hi type-op)) (setq hi= t))) (assert (<= lo hi)) (assert (or (< lo hi) (and lo= hi=))) (let ((limit 100000)) (cond ((or (<= hi 0) (>= lo 0) (and (<= (- limit) hi limit) (<= (- limit) lo limit))) (loop for x = (+ (random (- hi lo)) lo) do (when (or lo= (/= x lo)) (return x)))) (t (rcase (1 (random (min hi (float limit hi)))) (1 (- (random (min (float limit lo) (- lo))))))))))) (defmethod make-random-element-of-compound-type ((type-op (eql mod)) (args cons)) (let ((modulus (car args))) (assert (integerp modulus)) (assert (plusp modulus)) (make-random-element-of `(integer 0 (,modulus))))) (defmethod make-random-element-of-compound-type ((type-op (eql unsigned-byte)) (args t)) (if (null args) (make-random-element-of '(integer 0 *)) (let ((bits (car args))) (if (eq bits'*) (make-random-element-of '(integer 0 *)) (progn (assert (and (integerp bits) (>= bits 1))) (make-random-element-of `(integer 0 ,(1- (ash 1 bits))))))))) (defmethod make-random-element-of-compound-type ((type-op (eql eql)) (args cons)) (assert (null (cdr args))) (car args)) (defmethod make-random-element-of-compound-type ((type-op (eql member)) (args cons)) (random-from-seq args))
 ;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Sun Oct 10 07:13:47 2004 ;;;; Contains: Randomized tests on classes (in-package :cl-test) (compile-and-load "random-class-aux.lsp")
This source diff could not be displayed because it is too large. You can view the blob instead.
 ;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Contains: Code to randomly intern and unintern random strings ;;;; in a package. Exercises package and hash table routines (in-package :cl-test) (defconstant +max-len-random-symbol+ 63) (defun make-random-symbol (package) (declare (optimize (speed 3) (safety 3))) (loop (let* ((len (random (1+ +max-len-random-symbol+))) (str (make-string len))) (declare (type (integer 0 #.+max-len-random-symbol+) len)) (loop for i from 0 to (1- len) do (setf (schar str i) (schar +base-chars+ (random +num-base-chars+)))) (multiple-value-bind (symbol status) (intern (copy-seq str) package) (unless (equal str (symbol-name symbol)) (error "Intern gave bad symbol: ~A, ~A~%" str symbol)) (unless status (return symbol)))))) (defun queue-insert (q x) (declare (type cons q)) (push x (cdr q))) (defun queue-remove (q) (declare (type cons q)) (when (null (car q)) (when (null (cdr q)) (error "Attempty to remove from empty queue.~%")) (setf (car q) (nreverse (cdr q))) (setf (cdr q) nil)) (pop (car q))) (defun queue-empty (q) (and (null (car q)) (null (cdr q)))) (defun random-intern (n) (declare (fixnum n)) (let ((q (list nil)) (xp (defpackage "X" (:use)))) (declare (type cons q)) (loop for i from 1 to n do (if (and (= (random 2) 0) (not (queue-empty q))) (unintern (queue-remove q) xp) (queue-insert q (make-random-symbol xp)))))) (defun fill-intern (n) (declare (fixnum n)) (let ((xp (defpackage "X" (:use)))) (loop for i from 1 to n do (make-random-symbol xp))))
 ;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Sun Mar 6 20:36:56 2005 ;;;; Contains: Test that invoke the random type prop infrastructure, part 1 (in-package :cl-test) (def-type-prop-test special-operator-p 'special-operator-p '(symbol) 1) (def-type-prop-test type-of 'type-of '(t) 1) (def-type-prop-test typep.1 '(lambda (x y) (typep x (type-of y))) '(t t) 2) (def-type-prop-test typep.2 'typep (list t #'(lambda (x) (let ((type (make-random-type-containing x))) `(eql ,type)))) 2) (def-type-prop-test subtypep '(lambda (x y) (subtypep (type-of x) (type-of y))) '(t t) 2) (def-type-prop-test fboundp.1 'fboundp '(symbol) 1) (def-type-prop-test fboundp.2 'fboundp '((cons (eql setf) (cons symbol null))) 1) (def-type-prop-test functionp 'functionp '(t) 1) (def-type-prop-test compiled-function-p 'compiled-function-p '(t) 1) (def-type-prop-test not 'not '(t) 1) (def-type-prop-test eq 'eq (list '(and t (not number) (not character)) #'(lambda (x) (rcase (1 `(eql ,x)) (1 '(and t (not number) (not character)))))) 2) (def-type-prop-test eql.1 'eql '(t t) 2) (def-type-prop-test eql.2 'eql (list t #'(lambda (x) `(eql ,x))) 2) (def-type-prop-test equal.1 'equal '(t t) 2) (def-type-prop-test equal.2 'equal (list t #'(lambda (x) `(eql ,x))) 2) (def-type-prop-test equalp.1 'equalp '(t t) 2) (def-type-prop-test equalp.2 'equalp (list t #'(lambda (x) `(eql ,x))) 2) (def-type-prop-test identity 'identity '(t) 1) (def-type-prop-test complement '(lambda (f y) (funcall (complement f) y)) (list `(eql ,#'symbolp) t) 2) (def-type-prop-test constantly '(lambda (x) (funcall (constantly x))) '(t) 1) (def-type-prop-test and.1 'and '(t) 1) (def-type-prop-test and.2 'and '((or null t) t) 2) (def-type-prop-test and.3 'and '((or null t) (or null t) t) 3) (def-type-prop-test if.1 'if '(boolean t) 2) (def-type-prop-test if.2 'if '(boolean t t) 3) (def-type-prop-test if.3 '(lambda (p q x y z) (if p (if q x y) z)) '(boolean boolean t t t) 5) (def-type-prop-test if.4 '(lambda (p q x y z) (if p x (if q y z))) '(boolean boolean t t t) 5) (def-type-prop-test if.5 '(lambda (p q x y) (if (or p q) x y)) '(boolean boolean t t) 4) (def-type-prop-test if.6 '(lambda (p q x y) (if (and p q) x y)) '(boolean boolean t t) 4) (def-type-prop-test cond.1 '(lambda (p x y) (cond (p x) (t y))) '(boolean t t) 3) (def-type-prop-test cond.2 '(lambda (p x y) (cond (p x) (t y))) '((or null t) t t) 3) (def-type-prop-test or.1 'or '(t) 1) (def-type-prop-test or.2 'or '((or null t) t) 2) (def-type-prop-test or.3 'or '((or null null t) (or null t) t) 3) (def-type-prop-test when 'when '((or null t) t) 2) (def-type-prop-test unless 'unless '((or null t) t) 2) (def-type-prop-test slot-exists-p 'slot-exists-p '(t symbol) 2) (def-type-prop-test find-class 'find-class '(symbol null) 2) (def-type-prop-test class-of 'class-of '(t) 1) (def-type-prop-test find-restart 'find-restart '((and symbol (not null))) 1) (def-type-prop-test symbolp 'symbolp '(t) 1) (def-type-prop-test keywordp 'keywordp '(t) 1) (def-type-prop-test make-symbol 'make-symbol '(string) 1 :test #'(lambda (x y) (string= (symbol-name x) (symbol-name y)))) (def-type-prop-test symbol-name 'symbol-name '(symbol) 1) (def-type-prop-test symbol-package 'symbol-package '(symbol) 1) (def-type-prop-test boundp 'boundp '(symbol) 1) (def-type-prop-test find-symbol 'find-symbol '(string) 1) (def-type-prop-test find-package 'find-package '((or string symbol character)) 1)
 ;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Sun Mar 6 20:37:57 2005 ;;;; Contains: Tests that invoke the random type prop infrastructure, part 2 (in-package :cl-test) (def-type-prop-test =.1 '= '(number number) 2) (def-type-prop-test =.2 '= '(number number number) 3) (def-type-prop-test =.3 '= nil 4 :maxargs 10 :rest-type 'number) (def-type-prop-test =.4 '= '(integer integer) 2) (def-type-prop-test =.5 '= (list 'number #'(lambda (x) (if (coin) 'number `(eql ,x)))) 2) (def-type-prop-test =.6 '= (list 'number 'number #'(lambda (x y) (rcase (2 'number) (1 `(eql ,x)) (1 `(eql ,y))))) 3) (def-type-prop-test /=.1 '/= '(number number) 2) (def-type-prop-test /=.2 '/= '(number number number) 3) (def-type-prop-test /=.3 '/= nil 4 :maxargs 10 :rest-type 'number) (def-type-prop-test /=.4 '/= '(integer integer) 2) (def-type-prop-test /=.5 '/= (list 'number #'(lambda (x) (if (coin) 'number `(eql ,x)))) 2) (def-type-prop-test /=.6 '/= (list 'number 'number #'(lambda (x y) (rcase (2 'number) (1 `(eql ,x)) (1 `(eql ,y))))) 3) (def-type-prop-test <.1 '< '(real real) 2) (def-type-prop-test <.2 '< '(real real real) 3) (def-type-prop-test <.3 '< nil 4 :maxargs 10 :rest-type 'real) (def-type-prop-test <.4 '< '(integer integer) 2) (def-type-prop-test <.5 '< (list 'real #'(lambda (x) (if (coin) 'real `(eql ,x)))) 2) (def-type-prop-test <.6 '< (list 'real 'real #'(lambda (x y) (rcase (2 'real) (1 `(eql ,x)) (1 `(eql ,y))))) 3) (def-type-prop-test >.1 '> '(real real) 2) (def-type-prop-test >.2 '> '(real real real) 3) (def-type-prop-test >.3 '> nil 4 :maxargs 10 :rest-type 'real) (def-type-prop-test >.4 '> '(integer integer) 2) (def-type-prop-test >.5 '> (list 'real #'(lambda (x) (if (coin) 'real `(eql ,x)))) 2) (def-type-prop-test >.6 '> (list 'real 'real #'(lambda (x y) (rcase (2 'real) (1 `(eql ,x)) (1 `(eql ,y))))) 3) (def-type-prop-test <=.1 '<= '(real real) 2) (def-type-prop-test <=.2 '<= '(real real real) 3) (def-type-prop-test <=.3 '<= nil 4 :maxargs 10 :rest-type 'real) (def-type-prop-test <=.4 '<= '(integer integer) 2) (def-type-prop-test <=.5 '<= (list 'real #'(lambda (x) (if (coin) 'real `(eql ,x)))) 2) (def-type-prop-test <=.6 '<= (list 'real 'real #'(lambda (x y) (rcase (2 'real) (1 `(eql ,x)) (1 `(eql ,y))))) 3) (def-type-prop-test >=.1 '>= '(real real) 2) (def-type-prop-test >=.2 '>= '(real real real) 3) (def-type-prop-test >=.3 '>= nil 4 :maxargs 10 :rest-type 'real) (def-type-prop-test >=.4 '>= '(integer integer) 2) (def-type-prop-test >=.5 '>= (list 'real #'(lambda (x) (if (coin) 'real `(eql ,x)))) 2) (def-type-prop-test >=.6 '>= (list 'real 'real #'(lambda (x y) (rcase (2 'real) (1 `(eql ,x)) (1 `(eql ,y))))) 3) (def-type-prop-test min.1 'min nil 2 :maxargs 6 :rest-type 'integer) (def-type-prop-test min.2 'min nil 2 :maxargs 6 :rest-type 'rational) (def-type-prop-test min.3 'min nil 2 :maxargs 6 :rest-type 'real) (def-type-prop-test max.1 'max nil 2 :maxargs 6 :rest-type 'integer) (def-type-prop-test max.2 'max nil 2 :maxargs 6 :rest-type 'rational) (def-type-prop-test max.3 'max nil 2 :maxargs 6 :rest-type 'real) (def-type-prop-test minusp 'minusp '(real) 1) (def-type-prop-test plusp 'plusp '(real) 1) (def-type-prop-test zerop 'zerop '(number) 1) (def-type-prop-test floor.1 'floor '(real) 1) (def-type-prop-test floor.2 'floor '(real (and integer (not (satisfies zerop)))) 2) (def-type-prop-test floor.3 'floor '(real (and real (not (satisfies zerop)))) 2) (def-type-prop-test ffloor.1 'ffloor '(real) 1) (def-type-prop-test ffloor.2 'ffloor '(real (and integer (not (satisfies zerop)))) 2) (def-type-prop-test ffloor.3 'ffloor '(real (and real (not (satisfies zerop)))) 2) (def-type-prop-test ceiling.1 'ceiling '(real) 1) (def-type-prop-test ceiling.2 'ceiling '(real (and integer (not (satisfies zerop)))) 2) (def-type-prop-test ceiling.3 'ceiling '(real (and real (not (satisfies zerop)))) 2) (def-type-prop-test fceiling.1 'fceiling '(real) 1) (def-type-prop-test fceiling.2 'fceiling '(real (and integer (not (satisfies zerop)))) 2) (def-type-prop-test fceiling.3 'fceiling '(real (and real (not (satisfies zerop)))) 2) (def-type-prop-test truncate.1 'truncate '(real) 1) (def-type-prop-test truncate.2 'truncate '(real (and integer (not (satisfies zerop)))) 2) (def-type-prop-test truncate.3 'truncate '(real (and real (not (satisfies zerop)))) 2) (def-type-prop-test ftruncate.1 'ftruncate '(real) 1) (def-type-prop-test ftruncate.2 'ftruncate '(real (and integer (not (satisfies zerop)))) 2) (def-type-prop-test ftruncate.3 'ftruncate '(real (and real (not (satisfies zerop)))) 2) (def-type-prop-test round.1 'round '(real) 1) (def-type-prop-test round.2 'round '(real (and integer (not (satisfies zerop)))) 2) (def-type-prop-test round.3 'round '(real (and real (not (satisfies zerop)))) 2) (def-type-prop-test fround.1 'fround '(real) 1) (def-type-prop-test fround.2 'fround '(real (and integer (not (satisfies zerop)))) 2) (def-type-prop-test fround.3 'fround '(real (and real (not (satisfies zerop)))) 2)
 ;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Sun Mar 6 20:39:10 2005 ;;;; Contains: Tests that invoke the random type prop infrastructure, part 3 (in-package :cl-test) ;;; trig, hyperbolic functions here ;;; WARNING -- these tests may cause floating point overflow/underflow ;;; Ignore those failures (def-type-prop-test *.1 '* '(integer integer) 2) (def-type-prop-test *.2 '* nil 1 :rest-type 'integer :maxargs 4) (def-type-prop-test *.3 '* nil 2 :rest-type 'integer :maxargs 10) (def-type-prop-test *.4 '* '(real real) 2 :test #'approx=) (def-type-prop-test *.5 '* '(number number) 2 :test #'approx=) (def-type-prop-test \+.1 '+ '(integer integer) 2) (def-type-prop-test \+.2 '+ nil 1 :rest-type 'integer :maxargs 4) (def-type-prop-test \+.3 '+ nil 2 :rest-type 'integer :maxargs 10) (def-type-prop-test \+.4 '+ '(real real) 2 :test #'approx=) (def-type-prop-test \+.5 '+ '(number number) 2 :test #'approx=) (def-type-prop-test \-.1 '- '(integer integer) 2) (def-type-prop-test \-.2 '- nil 1 :rest-type 'integer :maxargs 4) (def-type-prop-test \-.3 '- nil 2 :rest-type 'integer :maxargs 10) (def-type-prop-test \-.4 '- '(real real) 2 :test #'approx=) (def-type-prop-test \-.5 '- '(number number) 2 :test #'approx=) (def-type-prop-test \-.6 '- '(number) 1) ;;; WARNING -- these tests may cause floating point overflow/underflow ;;; Ignore those failures (def-type-prop-test /.1 '/ '((and integer (not (satisfies zerop)))) 1) (def-type-prop-test /.2 '/ '((and rational (not (satisfies zerop)))) 1) (def-type-prop-test /.3 '/ '((and real (not (satisfies zerop)))) 1 :ignore 'arithmetic-error) (def-type-prop-test /.4 '/ '((and complex (not (satisfies zerop)))) 1 :ignore 'arithmetic-error) (def-type-prop-test /.5 '/ '(integer) 2 :maxargs 6 :rest-type '(and integer (not (satisfies zerop)))) (def-type-prop-test /.6 '/ '(rational) 2 :maxargs 6 :rest-type '(and rational (not (satisfies zerop)))) (def-type-prop-test /.7 '/ '(real) 2 :maxargs 6 :rest-type '(and real (not (satisfies zerop))) :test #'approx= :ignore 'arithmetic-error) (def-type-prop-test /.8 '/ '(number) 2 :maxargs 6 :rest-type '(and number (not (satisfies zerop))) :test #'approx= :ignore 'arithmetic-error) (def-type-prop-test 1+.1 '1+ '(integer) 1) (def-type-prop-test 1+.2 '1+ '(rational) 1) (def-type-prop-test 1+.3 '1+ '(real) 1) (def-type-prop-test 1+.4 '1+ '(number) 1) (def-type-prop-test 1-.1 '1- '(integer) 1) (def-type-prop-test 1-.2 '1- '(rational) 1) (def-type-prop-test 1-.3 '1- '(real) 1) (def-type-prop-test 1-.4 '1- '(number) 1) (def-type-prop-test abs.1 'abs '(integer) 1) (def-type-prop-test abs.2 'abs '(rational) 1) (def-type-prop-test abs.3 'abs '(real) 1) (def-type-prop-test abs.4 'abs '(number) 1) (def-type-prop-test evenp 'evenp '(integer) 1) (def-type-prop-test oddp 'oddp '(integer) 1) ;;; exp, expt here (def-type-prop-test gcd 'gcd nil 1 :maxargs 6 :rest-type 'integer) (def-type-prop-test lcm 'lcm nil 1 :maxargs 6 :rest-type 'integer) (def-type-prop-test log.1 'log '((and real (not (satisfies zerop)))) 1 :test #'approx=) (def-type-prop-test log.2 'log '((and number (not (satisfies zerop)))) 1 :test #'approx=) (def-type-prop-test mod.1 'mod '(integer (and integer (not (satisfies zerop)))) 2) (def-type-prop-test mod.2 'mod '(real (and real (not (satisfies zerop)))) 2 :test #'approx=) (def-type-prop-test rem.1 'rem '(integer (and integer (not (satisfies zerop)))) 2) (def-type-prop-test rem.2 'rem '(real (and real (not (satisfies zerop)))) 2 :test #'approx=) (def-type-prop-test signum.1 'signum '(integer) 1) (def-type-prop-test signum.2 'signum '(rational) 1) (def-type-prop-test signum.3 'signum '(real) 1) (def-type-prop-test signum.4 'signum '(number) 1) (def-type-prop-test sqrt.1 'sqrt '(integer) 1 :test #'approx=) (def-type-prop-test sqrt.2 'sqrt '(rational) 1 :test #'approx=) (def-type-prop-test sqrt.3 'sqrt '(real) 1 :test #'approx=) (def-type-prop-test sqrt.4 'sqrt '(number) 1 :test #'approx=) (def-type-prop-test isqrt 'isqrt '((integer 0)) 1) (def-type-prop-test numberp 'numberp '(t) 1) (def-type-prop-test complex.1 'complex '(integer) 1) (def-type-prop-test complex.2 'complex '(rational) 1) (def-type-prop-test complex.3 'complex '(real) 1) (def-type-prop-test complex.4 'complex '(rational rational) 2) (def-type-prop-test complex.5 'complex '(real real) 2) (def-type-prop-test complexp 'complexp '(t) 1) (def-type-prop-test conjugate 'conjugate '(number) 1) (def-type-prop-test phase.1 'phase '(real) 1) (def-type-prop-test phase.2 'phase '(number) 1 :test #'approx=) (def-type-prop-test realpart.1 'realpart '(real) 1) (def-type-prop-test realpart.2 'realpart '(number) 1) (def-type-prop-test imagpart.1 'imagpart '(real) 1) (def-type-prop-test imagpart.2 'imagpart '(number) 1) (def-type-prop-test realp 'realp '(t) 1) (def-type-prop-test numerator 'numerator '(rational) 1) (def-type-prop-test denominator 'denominator '(rational) 1) (def-type-prop-test rational 'rational '(real) 1) (def-type-prop-test rationalize 'rationalize '(real) 1) (def-type-prop-test rationalp 'rationalp '(t) 1) (def-type-prop-test ash.1 'ash '(integer (integer -32 32)) 2) (def-type-prop-test ash.2 'ash '(integer (integer -100 100)) 2) (def-type-prop-test integer-length 'integer-length '(integer) 1) (def-type-prop-test integerp 'integerp '(t) 1) (def-type-prop-test logand.1 'logand '(integer integer) 2) (def-type-prop-test logand.2 'logand nil 2 :rest-type 'integer :maxargs 6) (def-type-prop-test logandc1 'logandc1 '(integer integer) 2) (def-type-prop-test logandc2 'logandc2 '(integer integer) 2) (def-type-prop-test lognand 'lognand '(integer integer) 2) (def-type-prop-test lognor 'lognor '(integer integer) 2) (def-type-prop-test logeqv.1 'logeqv '(integer integer) 2) (def-type-prop-test logeqv.2 'logeqv nil 2 :rest-type 'integer :maxargs 6) (def-type-prop-test logior.1 'logior '(integer integer) 2) (def-type-prop-test logior.2 'logior nil 2 :rest-type 'integer :maxargs 6) (def-type-prop-test logxor.1 'logxor '(integer integer) 2) (def-type-prop-test logxor.2 'logxor nil 2 :rest-type 'integer :maxargs 6) (def-type-prop-test logorc1 'logorc1 '(integer integer) 2) (def-type-prop-test logorc2 'logorc2 '(integer integer) 2) (def-type-prop-test lognot 'lognot '(integer) 1) (def-type-prop-test logbitp.1 'logbitp '((integer 0 32) integer) 2) (def-type-prop-test logbitp.2 'logbitp '((integer 0 100) integer) 2) ; (def-type-prop-test logbitp.3 'logbitp '((integer 0) integer) 2) (def-type-prop-test logcount 'logcount '(integer) 1) (def-type-prop-test logtest 'logtest '(integer integer) 2) (def-type-prop-test decode-float.1 'decode-float '(float) 1) (def-type-prop-test decode-float.2 '(lambda (x) (nth-value 1 (decode-float x))) '(float) 1) (def-type-prop-test decode-float.3 '(lambda (x) (nth-value 2 (decode-float x))) '(float) 1) (def-type-prop-test float-radix 'float-radix '(float) 1) (def-type-prop-test scale-float 'scale-float '(float (integer -30 30)) 2 :ignore 'arithmetic-error :test #'approx=) (def-type-prop-test float-sign.1 'float-sign '(float) 1) (def-type-prop-test float-sign.2 'float-sign '(float float) 2) (def-type-prop-test float-digits 'float-digits '(float) 1) (def-type-prop-test float-precision 'float-precision '(float) 1) (def-type-prop-test integer-decode-float.1 'integer-decode-float '(float) 1) (def-type-prop-test integer-decode-float.2 '(lambda (x) (nth-value 1 (integer-decode-float x))) '(float) 1) (def-type-prop-test integer-decode-float.3 '(lambda (x) (nth-value 2 (integer-decode-float x))) '(float) 1) (def-type-prop-test float.1 'float '(real) 1) (def-type-prop-test float.2 'float '(real float) 2) (def-type-prop-test floatp 'floatp '(t) 1) (defun has-nonzero-length (x) (> (length x) 0)) (def-type-prop-test parse-integer.1 'parse-integer '((and (vector (member #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) (satisfies has-nonzero-length))) 1) (def-type-prop-test parse-integer.2 'parse-integer `((and (vector (member #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)) (satisfies has-nonzero-length)) (eql :start) ,#'(lambda (x &rest rest) (declare (ignore rest)) `(integer 0 (,(length x))))) 3) (def-type-prop-test sxhash 'sxhash '(t) 1)
 ;-*- Mode: Lisp -*- ;;;; Author: Paul Dietz ;;;; Created: Sun Mar 6 21:44:41 2005 ;;;; Contains: Test that invoke the random type prop infrastructure, part 4 (in-package :cl-test) (defun char-or-same (c &rest args) (declare (ignore args)) (if (coin) `(eql ,c) 'character)) (eval-when (:load-toplevel :execute) (compile 'char-or-same)) (def-type-prop-test char=.1 'char= nil 2 :rest-type 'base-char :maxargs 5) (def-type-prop-test char=.2 'char= '(character character) 2) (def-type-prop-test char=.3 'char= (list 'character #'char-or-same) 2) (def-type-prop-test char=.4 'char= (list 'character #'char-or-same #'char-or-same) 3) (def-type-prop-test char=.5 'char= '(character) 3 :rest-type #'char-or-same :maxargs 6) (def-type-prop-test char/=.1 'char/= nil 2 :rest-type 'base-char :maxargs 5) (def-type-prop-test char/=.2 'char/= '(character character) 2) (def-type-prop-test char/=.3 'char/= (list 'character #'char-or-same) 2) (def-type-prop-test char/=.4 'char/= (list 'character 'character #'char-or-same) 3) (def-type-prop-test char/=.5 'char/= nil 2 :rest-type 'character :maxargs 6) (def-type-prop-test char<=.1 'char<= nil 2 :rest-type 'base-char :maxargs 5) (def-type-prop-test char<=.2 'char<= '(character character) 2) (def-type-prop-test char<=.3 'char<= (list 'character #'char-or-same) 2) (def-type-prop-test char<=.4 'char<= (list 'character #'char-or-same #'char-or-same) 3) (def-type-prop-test char<=.5 'char<= '(character) 3 :rest-type #'char-or-same :maxargs 6) (def-type-prop-test char>=.1 'char>= nil 2 :rest-type 'base-char :maxargs 5) (def-type-prop-test char>=.2 'char>= '(character character) 2) (def-type-prop-test char>=.3 'char>= (list 'character #'char-or-same) 2) (def-type-prop-test char>=.4 'char>= (list 'character #'char-or-same #'char-or-same) 3) (def-type-prop-test char>=.5 'char>= '(character) 3 :rest-type #'char-or-same :maxargs 6)
{"ft_lang_label":"__label__en","ft_lang_prob":0.69360656,"math_prob":0.8710619,"size":222,"snap":"2020-10-2020-16","text_gpt3_token_len":66,"char_repetition_ratio":0.21100917,"word_repetition_ratio":0.0,"special_character_ratio":0.3198198,"punctuation_ratio":0.14285715,"nsfw_num_words":0,"has_unicode_error":false,"math_prob_llama3":0.99743813,"pos_list":[0],"im_url_duplicate_count":[null],"WARC_HEADER":"{\"WARC-Type\":\"response\",\"WARC-Date\":\"2020-04-07T12:35:56Z\",\"WARC-Record-ID\":\"<urn:uuid:54d3f4ba-8c7a-4d3d-9318-25106bc71996>\",\"Content-Length\":\"1049737\",\"Content-Type\":\"application/http; msgtype=response\",\"WARC-Warcinfo-ID\":\"<urn:uuid:2fb73208-810e-4d3d-a793-c5a125a1f353>\",\"WARC-Concurrent-To\":\"<urn:uuid:7fc8c3bc-b70b-4a89-8603-068bc30c1095>\",\"WARC-IP-Address\":\"148.251.248.130\",\"WARC-Target-URI\":\"https://gitlab.common-lisp.net/gpalter/ansi-test/commit/6203b6f0445e3dec6fc9be1357c1add078d87b30?view=parallel\",\"WARC-Payload-Digest\":\"sha1:4R6ROVAKTQOWIRAMVSQTZBV2O3H35A7K\",\"WARC-Block-Digest\":\"sha1:JRKN3KNJ5N3LHLYNQKKHD5EY74NFCR7V\",\"WARC-Truncated\":\"length\",\"WARC-Identified-Payload-Type\":\"text/html\",\"warc_filename\":\"/cc_download/warc_2020/CC-MAIN-2020-16/CC-MAIN-2020-16_segments_1585371799447.70_warc_CC-MAIN-20200407121105-20200407151605-00191.warc.gz\"}"}