106 lines
3.0 KiB
Plaintext
106 lines
3.0 KiB
Plaintext
;; Function To Be Tested: consp
|
|
;;
|
|
;; 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 (make-synonym-stream) must have an arg
|
|
;; to run on the SUN
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>6-2-2-consp.test
|
|
;;
|
|
;; Syntax: consp object
|
|
;;
|
|
;; Function Description: Returns non-nil iff object is a cons (i.e. not an atom), and NIL otherwise.
|
|
;;
|
|
;; Argument(s): object any cml object
|
|
;;
|
|
;; Returns: non-nil or NIL
|
|
;;
|
|
(do-test-group consp-group
|
|
:before
|
|
(test-defun consptest (object &optional (expected-value nil))
|
|
"See if an consp is or isn't true of an object, depending on expected-value; see if object consp is true of object iff object isn't an atom; see if (consp object) <=> (typep object cons)."
|
|
(and
|
|
;; Non-nil for true cases, NIL for others.
|
|
(cond
|
|
(expected-value
|
|
(consp object))
|
|
(t (eq (consp object) nil))
|
|
) ; cond
|
|
;; Test the equivalences in Steele's function description.
|
|
(eq (typep object 'cons) (not (typep object 'atom)))
|
|
(eq (consp object) (typep object 'cons))
|
|
) ; and
|
|
) ; test-defun
|
|
;;
|
|
(do-test consp-with-conses-test
|
|
(every #'(lambda (object) (consptest object t))
|
|
(list
|
|
'(nil)
|
|
'(a b c)
|
|
'(a b c . d)
|
|
(cons 1 2)
|
|
(list 1 2)
|
|
(append '(1) '(2))
|
|
(nconc '(1) '(2))
|
|
) ; list
|
|
) ; every
|
|
) ; do-test consp-with-conses-test
|
|
;;
|
|
(do-test consp-with-non-conses-test
|
|
(every 'consptest (list
|
|
(make-array '(5 5) :displaced-to (make-array '(6 6 6) :element-type '(or integer string))) ; array
|
|
(gentemp) ; atom
|
|
(1- most-negative-fixnum) ; bignum
|
|
0 ; bit
|
|
(make-array 5 :element-type 'bit :initial-contents '(0 0 1 1 0)) ; bit-vector
|
|
#\backspace ; character
|
|
'common ; common
|
|
#'cons ; compiled-function
|
|
#c( 6/7 3.00) ; complex
|
|
5.00 ; double-float
|
|
(random most-positive-fixnum) ; fixnum
|
|
(symbol-function 'atom) ; function
|
|
(make-hash-table) ; hash-table
|
|
4761 ; integer
|
|
:mot-de-clef ; keyword
|
|
37e5 ; long-float
|
|
(list) ; nil
|
|
() ; nil
|
|
'() ; nil
|
|
(eq 1 2) ; null
|
|
3.1415926535897932384d0 ; number
|
|
(car(list-all-packages)) ; package
|
|
(pathname) ; pathname
|
|
*random-state* ; random state
|
|
27/60 ; ratio
|
|
5 ; rational
|
|
(copy-readtable) ; readtable
|
|
6.25 ; short-float
|
|
(make-array '(2 2)) ; simple-array
|
|
'#*1001 ; simple-bit-vector
|
|
"twine" ; simple-string
|
|
(make-array 50 :initial-element 0) ; simple-vector
|
|
.001 ; single-float
|
|
#\* ; standard-char
|
|
(make-synonym-stream nil) ; stream
|
|
(make-array 20 :element-type 'string-char :initial-element #\0) ; string
|
|
#\. ; string-char
|
|
(gentemp) ; symbol
|
|
(not (equal 2 3)) ; t
|
|
'#( 5 4 3 2 1) ; vector
|
|
) ; list
|
|
) ; every
|
|
) ; do-test-consp-with-non-conses-test
|
|
) ; do-test-group
|
|
STOP
|
|
|
|
|
|
|
|
|