59 lines
1.6 KiB
Plaintext
59 lines
1.6 KiB
Plaintext
;; Function To Be Tested: rename-package
|
|
;;
|
|
;; Source: Guy L Steele's CLTL
|
|
;; Section: 11.7 Package System Functions and Variables
|
|
;; Page: 184
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Aug 14,1986
|
|
;;
|
|
;; Last Update: Dec 16, 1986
|
|
;;
|
|
;; Filed As: {ERIS}<LISPCORE>CML>TEST>11-7-rename-package.test
|
|
;;
|
|
;;
|
|
;; Syntax: (rename-package package new-name &optional new-nicknames)
|
|
;;
|
|
;; Function Description: The old name and all of the old nicknames of package
|
|
;; are eliminated and are replaced by new-name and new-nicknames.
|
|
;;
|
|
;; Argument(s): package
|
|
;; new-name: string or symbol
|
|
;; new-nicknames: list of strings or symbols
|
|
;;
|
|
;; Returns: nicknames for the package
|
|
;;
|
|
;; Constraints/Limitations: none
|
|
|
|
(do-test "rename-package"
|
|
(let ((test-package-1 (make-package 'old-package-1))
|
|
(test-package-2 (make-package 'old-package-2
|
|
:nicknames '("OLD-FOO" "OLD-BAR"))))
|
|
(and (rename-package test-package-1 "NEW-PACKAGE-1")
|
|
(rename-package test-package-2 "NEW-PACKAGE-2"
|
|
'("NEW-FOO" "NEW-BAR"))
|
|
(equal (package-name test-package-1) "NEW-PACKAGE-1")
|
|
(equal (package-name test-package-2) "NEW-PACKAGE-2")
|
|
(or (equal (package-nicknames test-package-2)
|
|
'("NEW-BAR" "NEW-FOO"))
|
|
(equal (reverse (package-nicknames test-package-2))
|
|
'("NEW-BAR" "NEW-FOO"))
|
|
)
|
|
(not (member (find-package 'old-package-1) (list-all-packages)))
|
|
(not (member (find-package 'old-package-2) (list-all-packages)))
|
|
(if (fboundp 'delete-package)
|
|
(progn (delete-package (find-package 'new-package-1))
|
|
(delete-package (find-package 'new-package-2))
|
|
(identity T)
|
|
)
|
|
T)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
STOP
|
|
|
|
|