/[gcl]/gcl/ansi-tests/cl-symbols.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/cl-symbols.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by pfdietz, Mon Nov 4 04:31:09 2002 UTC revision 1.10 by pfdietz, Fri Nov 29 21:48:06 2002 UTC
# Line 9  Line 9 
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)
# Line 1100  Line 1072 
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")
# Line 1167  Line 1136 
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)
# Line 1404  Line 1370 
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                

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26