source: trunk/source/tests/ansi-tests/keyword.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 3.8 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Feb 22 06:53:55 2004
4;;;; Contains: Tests of the KEYWORD package
5
6(in-package :cl-test)
7
8;; Check that each keyword satisfies keywordp
9
10(deftest keyword.1
11  (do-symbols (s "KEYWORD" t)
12    (unless (keywordp s)
13      (return (list s nil))))
14  t)
15
16;; Check that symbols that are interned in the KEYWORD
17;; package, but do not have KEYWORD as their home package,
18;; are in fact keywords.
19;;
20;; This came up on the #lisp irc channel
21
22;;;
23;;; The following two tests are improper, since (see the page for SYMBOL)
24;;; "The consequences are undefined if an attempt is made to alter the home
25;;;  package of a symbol external in the COMMON-LISP package or the KEYWORD package."
26;;;
27;;; They could be rewritten to search for a name that is not interned in KEYWORD.
28;;;
29
30#|
31(deftest keyword.4
32  (let ((name "SYMBOL-NAME-FOR-KEYWORD.4")
33        (kwp (find-package "KEYWORD")))
34    (let ((s (find-symbol name kwp)))
35      (when s (unintern s kwp))
36      ;; Now, create a symbol with this name
37      ;; and import it into the keyword package
38      (setq s (make-symbol name))
39      (import s kwp)
40      ;; Check that it's a keyword
41      (values
42       (eqlt (symbol-package s) kwp)
43       (eqlt (find-symbol name kwp) s)
44       (nth-value 1 (find-symbol name kwp))
45       (notnot (typep s 'keyword))
46       (if (boundp s) (eqlt s (symbol-value s)) :not-bound)
47       (notnot (constantp s)))))
48  t t :external t t t)
49
50(deftest keyword.5
51  (let* ((name "SYMBOL-NAME-FOR-KEYWORD.5")
52         (pkg-name "PACKAGE-FOR-KEYWORD.5")
53         (kwp (find-package "KEYWORD")))
54    (safely-delete-package pkg-name)
55    (let* ((pkg (make-package pkg-name :use nil))
56           (s (find-symbol name kwp)))
57      (when s (unintern s kwp))
58      ;; Now, create a symbol with this name
59      ;; and import it into the keyword package
60      (setq s (intern name pkg))
61      (import s kwp)
62      ;; Check that it's a keyword
63      (values
64       (eqlt (symbol-package s) pkg)
65       (eqlt (find-symbol name kwp) s)
66       (nth-value 1 (find-symbol name kwp))
67       (notnot (typep s 'keyword))
68       (if (boundp s) (eqlt s (symbol-value s)) :not-bound)
69       (notnot (constantp s)))))
70  t t :external t t t)
71
72(deftest keyword.6
73  (let* ((name "SYMBOL-NAME-FOR-KEYWORD.6")
74         (pkg-name "PACKAGE-FOR-KEYWORD.6")
75         (kwp (find-package "KEYWORD")))
76    (safely-delete-package pkg-name)
77    (let* ((pkg (make-package pkg-name :use nil))
78           (s (find-symbol name kwp))
79           s2)
80      (when s (unintern s kwp))
81      ;; Recreate a symbol with this name in the keyword package
82      ;; shadowing-import will displace this symbol
83      (setq s2 (intern name kwp))
84      ;; Now, create a symbol with this name
85      ;; and shadowing-import it into the keyword package
86      (setq s (intern name pkg))
87      (shadowing-import s kwp)
88      ;; Check that it's a keyword
89      (values
90       (eqt s s2)
91       (symbol-package s2)
92       (eqlt (symbol-package s) pkg)
93       (eqlt (find-symbol name kwp) s)
94       (nth-value 1 (find-symbol name kwp))
95       (notnot (typep s 'keyword))
96       (if (boundp s) (eqlt s (symbol-value s)) :not-bound)
97       (notnot (constantp s)))))
98  nil nil t t :external t t t)
99|#
100
101
102;;; Note that the case of a symbol inherited into KEYWORD cannot arise
103;;; standardly from user actions, since USE-PACKAGE disallows KEYWORD
104;;; as the package designated by its second argument.
105
106;; Every keyword is external
107(deftest keyword.2
108  (do-symbols (s "KEYWORD" t)
109    (multiple-value-bind (s2 access)
110        (find-symbol (symbol-name s) "KEYWORD")
111      (unless (and (eqt s s2)
112                   (eqt access :external))
113        (return (list s2 access)))))
114  t)
115
116;; Every keyword evaluates to itself
117(deftest keyword.3
118  (do-symbols (s "KEYWORD" t)
119    (cond
120     ((not (boundp s))
121      (return (list s "NOT-BOUND")))
122     ((not (eqt s (eval s)))
123      (return (list s (eval s))))))
124  t)
125
126   
127
Note: See TracBrowser for help on using the repository browser.