Skip to content
Snippets Groups Projects
Commit 7150913a authored by pfdietz's avatar pfdietz
Browse files

Simple test harness for subtypep on randomly generated types.

parent c90ca843
No related branches found
No related tags found
No related merge requests found
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Oct 6 05:04:45 2003
;;;; Contains: Generating random types and testing relationships on them
(in-package :cl-test)
(compile-and-load "random-aux.lsp")
(compile-and-load "random-int-form.lsp")
(defun make-random-type (size)
(if (<= size 1)
(rcase
(1 nil)
(1 t)
(1 `(eql ,(let ((r (ash 1 (random 45))))
(random-from-interval r (- r)))))
(1 (random-from-seq #(integer unsigned-byte ratio rational real float
short-float single-float double-float
long-float complex symbol cons)))
(1
(let* ((len (random *maximum-random-int-bits*))
(r1 (ash 1 len))
(r2 (+ r1 r1))
(x (- (random r2) r1))
(y (- (random r2) r1))
(lo (min x y))
(hi (max x y)))
`(integer ,lo ,hi)))
)
(rcase
(2 (destructuring-bind (s1 s2)
(random-partition (1- size) 2)
(let ((op (random-from-seq #(cons cons and or))))
`(,op ,(make-random-type s1)
,(make-random-type s2)))))
(1 `(not ,(make-random-type (1- size))))
)))
(defun test-random-types (n size)
(loop for t1 = (make-random-type size)
for t2 = (make-random-type size)
for i from 0 below n
;; do (print (list t1 t2))
do (when (and (= (mod i 100) 0) (> i 0))
(format t "~A " i) (finish-output *standard-output*))
when (test-types t1 t2)
collect (list t1 t2)
finally (terpri)))
(defun test-types (t1 t2)
(multiple-value-bind (sub success)
(subtypep t1 t2)
(when success
(if sub
(check-all-subtypep t1 t2)
(let ((nt1 `(not ,t1))
(nt2 `(not ,t2)))
(subtypep nt2 nt1))))))
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