source: trunk/source/tests/ansi-tests/cl-symbols-aux.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: 1.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Nov 28 06:43:51 2002
4;;;; Contains: Aux. functions for cl-symbols.lsp
5
6(in-package :cl-test)
7
8(declaim (optimize (safety 3)))
9
10(defun is-external-symbol-of (sym package)
11  (multiple-value-bind (sym2 status)
12      (find-symbol (symbol-name sym) package)
13    (and (eqt sym sym2)
14         (eqt status :external))))
15
16(defun test-if-not-in-cl-package (str)
17  (multiple-value-bind (sym status)
18      (find-symbol #+lower-case str #-lower-case (string-upcase str) 'common-lisp)
19      (or
20       ;; Symbol not present in the common lisp package as an external symbol
21       (not (eqt status :external))
22       ;; Check if it has any properties whose indicators are
23       ;; external in any of the standard packages or are accessible
24       ;; in CL-USER
25       (let ((plist (symbol-plist sym)))
26         (loop for e = plist then (cddr e)
27               for indicator = (car e)
28               while e
29               when (and (symbolp indicator)
30                         (or (is-external-symbol-of indicator
31                                                    "COMMON-LISP")
32                             (is-external-symbol-of indicator "KEYWORD")
33                             (eqt indicator (find-symbol
34                                             (symbol-name indicator)
35                                             "COMMON-LISP-USER"))))
36               collect indicator)))))
37
38(defun safe-symbol-name (sym)
39  (catch-type-error (symbol-name sym)))
40
41(defun safe-make-symbol (name)
42  (catch-type-error (make-symbol name)))
Note: See TracBrowser for help on using the repository browser.