Commit 7b0d9afe authored by camm's avatar camm

*** empty log message ***

parent bde19562
......@@ -4,6 +4,7 @@
;;;; Contains: Tests of DEFINE-METHOD-COMBINATION
(in-package :cl-test)
(defclass dmc-class-01a () ())
(defclass dmc-class-01b (dmc-class-01a) ())
(defclass dmc-class-01c (dmc-class-01a) ())
......@@ -113,6 +114,7 @@
(dolist (meth (compute-applicable-methods #'dmc-gf-03 (list 'a)))
(remove-method #'dmc-gf-03 meth)))
:good)
(eval-when (:load-toplevel :compile-toplevel :execute)
(report-and-ignore-errors
(define-method-combination times2
......
......@@ -196,88 +196,6 @@
;;; Put count-if-not tests here
;;position CM
(def-type-prop-test position.1 'position '(t sequence) 2)
(def-type-prop-test position.2 'position
(list t #'make-random-sequence-type-containing)
2)
(def-type-prop-test position.3 'position
(list t #'make-random-sequence-type-containing
'(eql :start)
#'(lambda (x s k1) (declare (ignore x k1))
`(integer 0 ,(length s))))
4)
(def-type-prop-test position.4 'position
(list t #'make-random-sequence-type-containing
'(eql :end)
#'(lambda (x s k1) (declare (ignore x k1))
`(integer 0 ,(length s))))
4)
(def-type-prop-test position.5 'position
(list t #'make-random-sequence-type-containing
'(eql :start)
#'(lambda (x s k1) (declare (ignore x k1))
`(integer 0 ,(length s)))
'(eql :end)
#'(lambda (x s k1 start k2) (declare (ignore x k1 k2))
`(integer ,start ,(length s))))
6)
(def-type-prop-test position.6 'position
(list '(or short-float single-float double-float long-float)
#'(lambda (f) `(vector (or ,(typecase f
(short-float 'short-float)
(single-float 'single-float)
(double-float 'double-float)
(long-float 'long-float)
(t 'float))
(eql ,f)))))
2)
(def-type-prop-test position.7 'position '(bit (vector bit)) 2)
(def-type-prop-test position.8 'position '((unsigned-byte 2) (vector (unsigned-byte 2))) 2)
(def-type-prop-test position.9 'position '((unsigned-byte 4) (vector (unsigned-byte 4))) 2)
(def-type-prop-test position.10 'position '((unsigned-byte 8) (vector (unsigned-byte 8))) 2)
;;; position-if tests
(def-type-prop-test position-if.1 'position-if
(list (let ((funs '(numberp rationalp realp floatp complexp
symbolp identity null functionp listp consp
arrayp vectorp simple-vector-p
stringp simple-string-p
bit-vector-p simple-bit-vector-p)))
`(member ,@funs ,@(mapcar #'symbol-function funs)))
'(or list vector))
2)
(def-type-prop-test position-if.2 'position-if
(list (let ((funs '(numberp rationalp realp floatp complexp
symbolp identity null functionp listp consp
arrayp vectorp simple-vector-p
stringp simple-string-p
bit-vector-p simple-bit-vector-p)))
`(member ,@funs ,@(mapcar #'symbol-function funs)))
'(or list vector)
'(eql :test)
(let ((test-funs '(eq eql equal equalp)))
`(member ,@test-funs ,@(mapcar #'symbol-function test-funs))))
4)
;;; Put position-if-not tests here
(def-type-prop-test length.1 'length '(sequence) 1)
(def-type-prop-test reverse.1 'reverse '(sequence) 1)
......
......@@ -91,11 +91,6 @@
;;;
;;;
(defvar *fn* nil)
(defvar *pms* nil)
(defvar *fm* nil)
(defun do-random-type-prop-tests
(operator arg-types minargs
&key
......@@ -203,16 +198,16 @@
(let* ((param-vals (loop for x in is-var?
for v in vals
when x collect v))
(fn (setq *fn* (cl:handler-bind
(fn (cl:handler-bind
(#+sbcl (sb-ext::compiler-note #'muffle-warning)
(warning #'muffle-warning))
(compile nil (setq *fm* form)))))
(compile nil form)))
(result
(if store-into-cell?
(let ((r (make-array nil :element-type upgraded-result-type)))
(apply fn r (setq *pms* param-vals))
(apply fn r param-vals)
(aref r))
(apply fn (setq *pms* param-vals)))))
(apply fn param-vals))))
(setq *random-type-prop-result*
(list :upgraded-result-type upgraded-result-type
:form form
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment