85 lines
3.0 KiB
Plaintext
85 lines
3.0 KiB
Plaintext
;; Function To Be Tested: getf
|
|
;;
|
|
;; Source: CLtL p. 166
|
|
;; Chapter 10: Symbols Section 1: The Property List
|
|
;;
|
|
;; Created By: Peter Reidy
|
|
;;
|
|
;; Creation Date: 20 June 86
|
|
;;
|
|
;; Last Update: 16 December 86
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>10-1-getf.test
|
|
;;
|
|
;;
|
|
;; Syntax: getf place indicator &optional default
|
|
;;
|
|
;; Function Description: Get the value of indicator from the property list stored in place. Return default if specified and the value of indicator isn't found. default defaults to nil. Note that the function returns the same value (nil) if nil is the value of the indicated property or if symbol does not have the indicated property.
|
|
;; getf differs from get in that place may be any form whose value is a symbol, whereas get requires a symbol.
|
|
;;
|
|
;; Argument(s): place - a form whose value is a symbol;
|
|
;; indicator - a list (anything for which listp returns t)
|
|
;; Returns: value of a property - if symbol has a property eq to indicator's;
|
|
;; default - if specified and the property's value is not found;
|
|
;; nil - if not found and no default specified.
|
|
;;
|
|
(do-test-group getf-group
|
|
;; First, create some property lists. Whether or not the symbol is bound shouldn't matter.
|
|
:before (progn
|
|
(setf (symbol-plist 'hundred) nil (symbol-plist 'thousand) nil)
|
|
(setf (get 'hundred 'power) 2
|
|
(get 'hundred 'factors) '(2 5 2 5)
|
|
(get 'thousand 'power) 3
|
|
(get 'thousand 'factors) '(2 5 2 5 2 5)
|
|
)
|
|
(test-setq list1000 (symbol-plist 'thousand))
|
|
(mapcar #'(lambda (symbol) (setf (symbol-plist symbol) nil)) '(trunk branch twig leaf))
|
|
(setf
|
|
(get 'trunk 'offshoot) 'branch
|
|
(get 'branch 'offshoot) 'twig
|
|
(get 'twig 'offshoot) 'leaf
|
|
)
|
|
) ; progn
|
|
;;
|
|
;; Try some ordinary getfs.
|
|
(do-test "regular getf test"
|
|
(AND
|
|
(getf '(0 1 2 3 4 5) 4)
|
|
;; NIL because 5 isn't in a property-name position
|
|
(null (getf '(0 1 2 3 4 5) 5))
|
|
;; NIL becase 6 isn't there at all
|
|
(null (getf '(0 1 2 3 4 5) 6))
|
|
(= (getf list1000 'power) 3)
|
|
;; Nested getfs - the property is itself a list.
|
|
(eq (getf (getf (symbol-plist 'thousand) 'factors) 2) 5)
|
|
)
|
|
)
|
|
;;
|
|
;; Try the default feature
|
|
(do-test "default getf test"
|
|
(AND
|
|
(= 10000 (getf (symbol-plist 'hundred) 'square 10000))
|
|
;; Default should not override specified properties.
|
|
(not (eql 50 (getf (symbol-plist 'hundred) 'power 50)))
|
|
(getf '(Ennis concrete Hollyhock stucco Martin brick) 'Hollyhock nil)
|
|
)
|
|
)
|
|
;;
|
|
;; Show that getf works several layers deep.
|
|
(do-test "recursive getf test"
|
|
(setf
|
|
(get 'leaf 'color)
|
|
'orange
|
|
(getf (symbol-plist 'leaf) 'color)
|
|
'vermillion
|
|
(getf (symbol-plist (getf (symbol-plist 'twig) 'offshoot)) 'color)
|
|
'blue
|
|
(getf (symbol-plist (getf (symbol-plist (getf (symbol-plist 'branch) 'offshoot)) 'offshoot)) 'color)
|
|
'black
|
|
(getf (symbol-plist (getf (symbol-plist (getf (symbol-plist (getf (symbol-plist 'trunk) 'offshoot)) 'offshoot)) 'offshoot)) 'color)
|
|
'green
|
|
) ; setf
|
|
(equal (getf (symbol-plist 'leaf) 'color) 'green)
|
|
)
|
|
)
|
|
STOP |