9 |
|
|
10 |
(declaim (optimize (safety 3))) |
(declaim (optimize (safety 3))) |
11 |
|
|
|
(defun is-external-symbol-of (sym package) |
|
|
(multiple-value-bind (sym2 status) |
|
|
(find-symbol (symbol-name sym) package) |
|
|
(and (eqt sym sym2) |
|
|
(eqt status :external)))) |
|
|
|
|
|
(defun test-if-not-in-cl-package (str) |
|
|
(multiple-value-bind (sym status) |
|
|
(find-symbol (string-upcase str) 'common-lisp) |
|
|
(declare (ignore sym)) |
|
|
(or |
|
|
;; Symbol not present in the common lisp package |
|
|
(not status) |
|
|
;; Check if it has any properties whose indicators are |
|
|
;; external in any of the standard packages or are accessible |
|
|
;; in CL-USER |
|
|
(and (eqt status :external) |
|
|
(let ((plist (symbol-plist sym))) |
|
|
(loop for e = plist then (cddr e) |
|
|
while e |
|
|
for indicator = (car e) |
|
|
when (and (symbolp indicator) |
|
|
(or (is-external-symbol-of indicator "COMMON-LISP") |
|
|
(is-external-symbol-of indicator "KEYWORD") |
|
|
(eqt indicator (find-symbol (symbol-name indicator) |
|
|
"COMMON-LISP-USER")))) |
|
|
collect indicator)))))) |
|
|
|
|
12 |
;;; Test for the presence of every darned symbol |
;;; Test for the presence of every darned symbol |
13 |
;;; the standard says should be in the CL package. |
;;; the standard says should be in the CL package. |
14 |
;;; Also, test that they have no prohibited plist indicators (section 11.1.2.1.1) |
;;; Also, test that they have no prohibited plist indicators (section 11.1.2.1.1) |
1072 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1073 |
;;; symbol-name |
;;; symbol-name |
1074 |
|
|
|
(defun safe-symbol-name (sym) |
|
|
(catch-type-error (symbol-name sym))) |
|
|
|
|
1075 |
(deftest symbol-name-1 |
(deftest symbol-name-1 |
1076 |
(safe-symbol-name '|ABCD|) |
(safe-symbol-name '|ABCD|) |
1077 |
"ABCD") |
"ABCD") |
1136 |
(symbol-plist (make-symbol "C")) |
(symbol-plist (make-symbol "C")) |
1137 |
nil) |
nil) |
1138 |
|
|
|
(defun safe-make-symbol (name) |
|
|
(catch-type-error (make-symbol name))) |
|
|
|
|
1139 |
(deftest make-symbol-9 |
(deftest make-symbol-9 |
1140 |
(safe-make-symbol nil) |
(safe-make-symbol nil) |
1141 |
type-error) |
type-error) |
1370 |
(deftest gensym-19 |
(deftest gensym-19 |
1371 |
(catch-type-error (gensym #\x)) |
(catch-type-error (gensym #\x)) |
1372 |
type-error) |
type-error) |
1373 |
|
|
1374 |
|
;;;;;;;;;;;;;;;;;;;; |
1375 |
|
|
1376 |
|
;;; Tests of CL package constraints from section 11.1.2.1.1 |
1377 |
|
|
1378 |
|
;;; Check that all symbols listed as 'functions' or 'accessors' |
1379 |
|
;;; are indeed functions. |
1380 |
|
|
1381 |
|
(deftest cl-function-symbols.1 |
1382 |
|
(loop |
1383 |
|
for s in (append *cl-function-symbols* *cl-accessor-symbols*) |
1384 |
|
when (or (not (fboundp s)) |
1385 |
|
(macro-function s) |
1386 |
|
(special-operator-p s) |
1387 |
|
(not (symbol-function s))) |
1388 |
|
collect s) |
1389 |
|
nil) |
1390 |
|
|
1391 |
|
;;; Check that all symols listed as 'macros' are macros. |
1392 |
|
|
1393 |
|
(deftest cl-macro-symbols.1 |
1394 |
|
(loop |
1395 |
|
for s in *cl-macro-symbols* |
1396 |
|
when (or (not (fboundp s)) |
1397 |
|
(not (macro-function s))) |
1398 |
|
collect s) |
1399 |
|
nil) |
1400 |
|
|
1401 |
|
;;; Check that all constants are indeed constant |
1402 |
|
|
1403 |
|
(deftest cl-constant-symbols.1 |
1404 |
|
(loop |
1405 |
|
for s in *cl-constant-symbols* |
1406 |
|
when (or (not (boundp s)) |
1407 |
|
(not (constantp s))) |
1408 |
|
collect s) |
1409 |
|
nil) |
1410 |
|
|
1411 |
|
;;; Check that all global variables have values |
1412 |
|
|
1413 |
|
(deftest cl-variable-symbols.1 |
1414 |
|
(loop |
1415 |
|
for s in *cl-variable-symbols* |
1416 |
|
when (not (boundp s)) |
1417 |
|
collect s) |
1418 |
|
nil) |
1419 |
|
|
1420 |
|
|