70 lines
2.1 KiB
Plaintext
70 lines
2.1 KiB
Plaintext
;; Function To Be Tested: remprop
|
|
;;
|
|
;; 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-remprop.test
|
|
;;
|
|
;; Syntax: remprop symbol indicator
|
|
;;
|
|
;; Function Description: remove from symbol's property list the property eq to indicator.
|
|
;;
|
|
;; Argument(s): symbol - a valid CML symbol;
|
|
;; indicator - any valid CML expression
|
|
;; Returns: property indicator if found (i.e. if symbol has a property with an indicator eq to indicator;
|
|
;; nil - if not found
|
|
;;
|
|
(do-test-group remprop-group
|
|
;; First, create a property list.
|
|
:before (progn
|
|
(test-setq twenty-five 25)
|
|
(setf (symbol-plist 'twenty-five) nil)
|
|
(setf (symbol-plist 'minus25) nil)
|
|
(setf (get 'twenty-five 'sqrt) 5)
|
|
(setf (get 'twenty-five 30) 35)
|
|
(setf (get 'twenty-five 'inverse) 'minus25)
|
|
(setf (get 'minus25 'sign) 'negative)
|
|
)
|
|
(do-test "remprop test"
|
|
(AND
|
|
;; First, show that the properties are there.
|
|
(get 'twenty-five 'inverse)
|
|
(get 'twenty-five 'sqrt)
|
|
(get 'twenty-five 30)
|
|
;; Now get rid of one.
|
|
(remprop 'twenty-five 'sqrt)
|
|
(null (get 'twenty-five 'sqrt))
|
|
;; Show that something eq to indicator will do.
|
|
(remprop 'twenty-five (+ 15 15))
|
|
(null (getf (symbol-plist 'twenty-five) 30))
|
|
;; What evaluates to a symbol ought to be acceptable as symbol.
|
|
(symbol-plist 'minus25)
|
|
(remprop (get 'twenty-five 'inverse) 'sign)
|
|
(null (symbol-plist 'minus25))
|
|
;; One property should be left; get rid of it and the list should be empty.
|
|
(remprop 'twenty-five 'inverse)
|
|
(null (symbol-plist 'twenty-five))
|
|
;; Remprop should work on arbitrary symbols and properties.
|
|
(null (remprop (gensym) 'eyecolor))
|
|
)
|
|
)
|
|
;;
|
|
;; Remprop must return non-nil if it found the property
|
|
(do-test "remprop returns non-nil if it found the property"
|
|
;; NOTE: not working in 6 December sysout; see AR 5973.
|
|
(setf (get 'tarski 'nil) t)
|
|
(and
|
|
(evenp (search '(nil) (symbol-plist 'tarski))) ; show that it's in property position
|
|
(remprop 'tarski nil)
|
|
)
|
|
)
|
|
)
|
|
STOP
|
|
|