keyword.lsp 3.88 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Feb 22 06:53:55 2004
;;;; Contains: Tests of the KEYWORD package

(in-package :cl-test)

;; Check that each keyword satisfies keywordp

(deftest keyword.1
  (do-symbols (s "KEYWORD" t)
    (unless (keywordp s)
      (return (list s nil))))
  t)

16 17 18 19 20 21
;; Check that symbols that are interned in the KEYWORD
;; package, but do not have KEYWORD as their home package,
;; are in fact keywords.
;;
;; This came up on the #lisp irc channel

22 23 24 25 26 27 28 29 30
;;;
;;; The following two tests are improper, since (see the page for SYMBOL)
;;; "The consequences are undefined if an attempt is made to alter the home
;;;  package of a symbol external in the COMMON-LISP package or the KEYWORD package."
;;;
;;; They could be rewritten to search for a name that is not interned in KEYWORD.
;;;

#|
31 32
(deftest keyword.4
  (let ((name "SYMBOL-NAME-FOR-KEYWORD.4")
sds's avatar
sds committed
33
        (kwp (find-package "KEYWORD")))
34 35 36 37 38 39 40 41
    (let ((s (find-symbol name kwp)))
      (when s (unintern s kwp))
      ;; Now, create a symbol with this name
      ;; and import it into the keyword package
      (setq s (make-symbol name))
      (import s kwp)
      ;; Check that it's a keyword
      (values
42
       (eqlt (symbol-package s) kwp)
43 44
       (eqlt (find-symbol name kwp) s)
       (nth-value 1 (find-symbol name kwp))
45 46 47
       (notnot (typep s 'keyword))
       (if (boundp s) (eqlt s (symbol-value s)) :not-bound)
       (notnot (constantp s)))))
48
  t t :external t t t)
49

50 51
(deftest keyword.5
  (let* ((name "SYMBOL-NAME-FOR-KEYWORD.5")
sds's avatar
sds committed
52 53
         (pkg-name "PACKAGE-FOR-KEYWORD.5")
         (kwp (find-package "KEYWORD")))
54 55
    (safely-delete-package pkg-name)
    (let* ((pkg (make-package pkg-name :use nil))
sds's avatar
sds committed
56
           (s (find-symbol name kwp)))
57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73
      (when s (unintern s kwp))
      ;; Now, create a symbol with this name
      ;; and import it into the keyword package
      (setq s (intern name pkg))
      (import s kwp)
      ;; Check that it's a keyword
      (values
       (eqlt (symbol-package s) pkg)
       (eqlt (find-symbol name kwp) s)
       (nth-value 1 (find-symbol name kwp))
       (notnot (typep s 'keyword))
       (if (boundp s) (eqlt s (symbol-value s)) :not-bound)
       (notnot (constantp s)))))
  t t :external t t t)

(deftest keyword.6
  (let* ((name "SYMBOL-NAME-FOR-KEYWORD.6")
sds's avatar
sds committed
74 75
         (pkg-name "PACKAGE-FOR-KEYWORD.6")
         (kwp (find-package "KEYWORD")))
76 77
    (safely-delete-package pkg-name)
    (let* ((pkg (make-package pkg-name :use nil))
sds's avatar
sds committed
78 79
           (s (find-symbol name kwp))
           s2)
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
      (when s (unintern s kwp))
      ;; Recreate a symbol with this name in the keyword package
      ;; shadowing-import will displace this symbol
      (setq s2 (intern name kwp))
      ;; Now, create a symbol with this name
      ;; and shadowing-import it into the keyword package
      (setq s (intern name pkg))
      (shadowing-import s kwp)
      ;; Check that it's a keyword
      (values
       (eqt s s2)
       (symbol-package s2)
       (eqlt (symbol-package s) pkg)
       (eqlt (find-symbol name kwp) s)
       (nth-value 1 (find-symbol name kwp))
       (notnot (typep s 'keyword))
       (if (boundp s) (eqlt s (symbol-value s)) :not-bound)
       (notnot (constantp s)))))
  nil nil t t :external t t t)
99
|#
100 101


102 103 104 105
;;; Note that the case of a symbol inherited into KEYWORD cannot arise
;;; standardly from user actions, since USE-PACKAGE disallows KEYWORD
;;; as the package designated by its second argument.

106 107 108 109
;; Every keyword is external
(deftest keyword.2
  (do-symbols (s "KEYWORD" t)
    (multiple-value-bind (s2 access)
sds's avatar
sds committed
110
        (find-symbol (symbol-name s) "KEYWORD")
111
      (unless (and (eqt s s2)
sds's avatar
sds committed
112 113
                   (eqt access :external))
        (return (list s2 access)))))
114 115 116 117 118
  t)

;; Every keyword evaluates to itself
(deftest keyword.3
  (do-symbols (s "KEYWORD" t)
119 120 121 122 123
    (cond
     ((not (boundp s))
      (return (list s "NOT-BOUND")))
     ((not (eqt s (eval s)))
      (return (list s (eval s))))))
124 125
  t)

sds's avatar
sds committed
126

127