80 lines
1.9 KiB
Plaintext
80 lines
1.9 KiB
Plaintext
;; Function To Be Tested: rationalp
|
|
;;
|
|
;; Source: CLtL p. 74
|
|
;;
|
|
;; Chapter 6: Predicates Section 2-2: Specific Data Type Predicates
|
|
;;
|
|
;; Created By: Peter Reidy
|
|
;;
|
|
;; Creation Date: 19 September 86
|
|
;;
|
|
;; Last Update: Feb 4, 1987 Jim Blum - removed :5 keyword from last test
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>6-2-2-rationalp.test
|
|
;;
|
|
;; Syntax: rationalp object
|
|
;;
|
|
;; Function Description: True iff object is any type of number, NIL otherwise.
|
|
;;
|
|
;; Argument(s): object any cml object
|
|
;;
|
|
;; Returns: non-nil or NIL
|
|
;;
|
|
(do-test-group rationalp-group
|
|
:before
|
|
(progn
|
|
(test-setq five 5)
|
|
(test-defun rationalptest (object &optional (expected-value nil))
|
|
"See that (rationalp object) <=> (typep object 'rational); see that, if the expected value is true, the object is either an integer or a ratio; see that the predicate is true or false, depending on the expected value."
|
|
(and
|
|
(eq (rationalp object) (typep object 'rational))
|
|
(cond
|
|
(expected-value
|
|
(and
|
|
(rationalp object)
|
|
(or (typep object 'ratio) (integerp object))
|
|
)
|
|
)
|
|
(t (null (rationalp object)))
|
|
) ; cond
|
|
) ; and
|
|
) ; test-defun
|
|
) ; progn
|
|
;;
|
|
(do-test rationalp-with-rationals-test
|
|
(every #'(lambda (object) (rationalptest object t))
|
|
(list
|
|
(random most-positive-fixnum) ; integers
|
|
(- (random most-positive-fixnum))
|
|
five
|
|
'5
|
|
(eval 'five)
|
|
#7r55
|
|
3/2 ; ratios
|
|
-16/2
|
|
#o-17/32
|
|
#x11/eff
|
|
#7r33/66
|
|
) ; list
|
|
) ; every
|
|
) ; do-test rationalp-with-rationals-test
|
|
;;
|
|
(do-test rationalp-with-non-rationals-test
|
|
(every 'rationalptest
|
|
(list
|
|
'(5)
|
|
"5"
|
|
(list 5)
|
|
#\5
|
|
'five
|
|
pi ; float
|
|
17.02020e12
|
|
#c(5 5) ; complex
|
|
(caddr (list "5" '(5) (apply '+ (list pi 3 #7r12/24)) (copy-readtable)))
|
|
) ; list
|
|
) ; every
|
|
) ; do-test rationalp-with-non-rationals-test
|
|
) ; do-test-group
|
|
STOP
|
|
|