diff --git a/tests.lisp b/tests.lisp index 21d670a456c3fc930a4425a57bbbf3cdcb0acb1f..8e1964851c6040a2b8f14f6c5fa984b7403427b4 100644 --- a/tests.lisp +++ b/tests.lisp @@ -1305,6 +1305,28 @@ nil t) +(macrolet + ((test (type numbers) + `(deftest ,(format-symbol t "CDR5.~A" type) + (let ((numbers ,numbers)) + (values (mapcar (of-type ',(format-symbol t "NEGATIVE-~A" type)) numbers) + (mapcar (of-type ',(format-symbol t "NON-POSITIVE-~A" type)) numbers) + (mapcar (of-type ',(format-symbol t "NON-NEGATIVE-~A" type)) numbers) + (mapcar (of-type ',(format-symbol t "POSITIVE-~A" type)) numbers))) + (t t t nil nil nil nil) + (t t t t nil nil nil) + (nil nil nil t t t t) + (nil nil nil nil t t t)))) + (test fixnum (list most-negative-fixnum -42 -1 0 1 42 most-positive-fixnum)) + (test integer (list (1- most-negative-fixnum) -42 -1 0 1 42 (1+ most-positive-fixnum))) + (test rational (list (1- most-negative-fixnum) -42/13 -1 0 1 42/13 (1+ most-positive-fixnum))) + (test real (list most-negative-long-float -42/13 -1 0 1 42/13 most-positive-long-float)) + (test float (list most-negative-short-float -42.02 -1.0 0.0 1.0 42.02 most-positive-short-float)) + (test short-float (list most-negative-short-float -42.02s0 -1.0s0 0.0s0 1.0s0 42.02s0 most-positive-short-float)) + (test single-float (list most-negative-single-float -42.02f0 -1.0f0 0.0f0 1.0f0 42.02f0 most-positive-single-float)) + (test double-float (list most-negative-double-float -42.02d0 -1.0d0 0.0d0 1.0d0 42.02d0 most-positive-double-float)) + (test long-float (list most-negative-long-float -42.02l0 -1.0l0 0.0l0 1.0l0 42.02l0 most-positive-long-float))) + ;;;; Bindings (declaim (notinline opaque)) diff --git a/types.lisp b/types.lisp index f9127e94e38c17f0f5b351d0dea13297a90c944e..52332feae462a7c4be00695d664186f4142fe94e 100644 --- a/types.lisp +++ b/types.lisp @@ -27,7 +27,13 @@ ARRAY-DIMENSION-LIMIT." (let ((result (format-symbol :alexandria "~A-P" (symbol-name sybtype-name)))) (push result predicate-names) - result))) + result)) + (make-docstring (range-beg range-end range-type) + (let ((inf (ecase range-type (:negative "-inf") (:positive "+inf")))) + (format nil "Type specifier denoting the ~(~A~) range from ~A to ~A." + type + (if (equal range-beg ''*) inf (ensure-car range-beg)) + (if (equal range-end ''*) inf (ensure-car range-end)))))) (let* ((negative-name (make-subtype-name "NEGATIVE-~A")) (non-positive-name (make-subtype-name "NON-POSITIVE-~A")) (non-negative-name (make-subtype-name "NON-NEGATIVE-~A")) @@ -45,26 +51,30 @@ ARRAY-DIMENSION-LIMIT." above-zero positive-extremum zero) (ecase type (fixnum (values 'most-negative-fixnum -1 1 'most-positive-fixnum 0)) - (integer (values '* -1 1 '* 0)) - (rational (values '* '(0) '(0) '* 0)) - (real (values '* '(0) '(0) '* 0)) - (float (values '* '(0.0E0) '(0.0E0) '* 0.0E0)) - (short-float (values '* '(0.0S0) '(0.0S0) '* 0.0S0)) - (single-float (values '* '(0.0F0) '(0.0F0) '* 0.0F0)) - (double-float (values '* '(0.0D0) '(0.0D0) '* 0.0D0)) - (long-float (values '* '(0.0L0) '(0.0L0) '* 0.0L0)))) + (integer (values ''* -1 1 ''* 0)) + (rational (values ''* '(0) '(0) ''* 0)) + (real (values ''* '(0) '(0) ''* 0)) + (float (values ''* '(0.0E0) '(0.0E0) ''* 0.0E0)) + (short-float (values ''* '(0.0S0) '(0.0S0) ''* 0.0S0)) + (single-float (values ''* '(0.0F0) '(0.0F0) ''* 0.0F0)) + (double-float (values ''* '(0.0D0) '(0.0D0) ''* 0.0D0)) + (long-float (values ''* '(0.0L0) '(0.0L0) ''* 0.0L0)))) `(progn (deftype ,negative-name () - `(,',base-type ,',negative-extremum ,',below-zero)) + ,(make-docstring negative-extremum below-zero :negative) + `(,',base-type ,,negative-extremum ,',below-zero)) (deftype ,non-positive-name () - `(,',base-type ,',negative-extremum ,',zero)) + ,(make-docstring negative-extremum zero :negative) + `(,',base-type ,,negative-extremum ,',zero)) (deftype ,non-negative-name () - `(,',base-type ,',zero ,',positive-extremum)) + ,(make-docstring zero positive-extremum :positive) + `(,',base-type ,',zero ,,positive-extremum)) (deftype ,positive-name () - `(,',base-type ,',above-zero ,',positive-extremum)) + ,(make-docstring above-zero positive-extremum :positive) + `(,',base-type ,',above-zero ,,positive-extremum)) (declaim (inline ,@predicate-names))