55 lines
1.3 KiB
Plaintext
55 lines
1.3 KiB
Plaintext
;; Function To Be Tested: identity
|
|
;;
|
|
;; Source: Guy L Steele's CLTL Chapter 25:Identity Function
|
|
;; Section: 25.5 Other Environment Inquiries
|
|
;; Page: 448
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Aug 21,1986
|
|
;;
|
|
;; Last Update: Oct 7, 1986
|
|
;;
|
|
;; Filed As: {ERIS}<LISPCORE>CML>TEST>25-5-identity.test
|
|
;;
|
|
;;
|
|
;; Syntax: (identity object)
|
|
;;
|
|
;; Function Description: This function is occasionally useful as an argument to
|
|
;; other functions that require functions as arguments.
|
|
;;
|
|
;; Argument(s): none
|
|
;;
|
|
;; Returns: string
|
|
;;
|
|
;; Constraints/Limitations: none
|
|
|
|
|
|
(do-test-group ("identity-test-setup"
|
|
:before (progn
|
|
(setq array-object (make-array 10))
|
|
(setq hash-table-object (make-hash-table))
|
|
(setq random-state-object *random-state*)
|
|
(setq read-table-object *readtable*)
|
|
(setq stream-object *standard-output*)
|
|
(setq structure-object (defstruct ship x y z))
|
|
|
|
(setq objects '(19 3/4 #C(1 -1) #\a 'abc "abc" '(a b c) t nil
|
|
array-object hash-table-object *default-pathname-defaults*
|
|
random-state-object read-table-object stream-object
|
|
structure-object))
|
|
|
|
(defun identityp (pair)
|
|
(if (equal (car pair) (cdr pair)) t nil))
|
|
))
|
|
(do-test "identity-test"
|
|
(and (setq original-returned
|
|
(pairlis objects (mapcar #'identity objects)))
|
|
(notany #'null (mapcar #'identityp original-returned)))))
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|