find-all-symbols.lsp 4.1 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Feb 22 07:10:22 2004
;;;; Contains: Tests for FIND-ALL-SYMBOLS

(in-package :cl-test)

(deftest find-all-symbols.1
  (let ((all-packages (list-all-packages)))
    (loop
     for package in all-packages
     append
     (let ((failures nil))
       (do-symbols (sym package failures)
sds's avatar
sds committed
15 16 17 18 19 20 21 22 23 24
         (when (eql (symbol-package sym) package)
           (let* ((name (symbol-name sym))
                  (similar (find-all-symbols name))
                  (similar2 (find-all-symbols sym)))
             (unless (and (member sym similar)
                          (subsetp similar similar2)
                          (subsetp similar2 similar)
                          (loop for sym2 in similar
                                always (string= name (symbol-name sym2))))
               (push sym failures))))))))
25 26
  nil)

pfdietz's avatar
pfdietz committed
27 28
;;; FIXME -- test that each symbol found is accessible in some package

29 30
(deftest find-all-symbols.2
  (loop for i from 0 to 255
sds's avatar
sds committed
31 32 33 34 35 36
        for c = (code-char i)
        when (and (characterp c)
                  (loop for sym in (find-all-symbols c)
                        thereis (not (string= (symbol-name sym)
                                              (string c)))))
        collect c)
37
  nil)
38 39 40 41 42

;;; Unusual strings

(deftest find-all-symbols.3
  (let* ((name (make-array '(3) :initial-contents "NIL"
sds's avatar
sds committed
43 44
                           :element-type 'base-char))
         (symbols (find-all-symbols name)))
45 46 47 48 49 50 51
    (values
     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
     (some #'not symbols)))
  t t)

(deftest find-all-symbols.4
  (let* ((name (make-array '(5) :initial-contents "NILXY"
sds's avatar
sds committed
52 53 54
                           :fill-pointer 3
                           :element-type 'character))
         (symbols (find-all-symbols name)))
55 56 57 58 59 60 61
    (values
     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
     (some #'not symbols)))
  t t)

(deftest find-all-symbols.5
  (let* ((name (make-array '(5) :initial-contents "NILXY"
sds's avatar
sds committed
62 63 64
                           :fill-pointer 3
                           :element-type 'base-char))
         (symbols (find-all-symbols name)))
65 66 67 68 69 70 71
    (values
     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
     (some #'not symbols)))
  t t)

(deftest find-all-symbols.6
  (let* ((name (make-array '(3) :initial-contents "NIL"
sds's avatar
sds committed
72 73 74
                           :adjustable t
                           :element-type 'base-char))
         (symbols (find-all-symbols name)))
75 76 77 78 79 80 81
    (values
     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
     (some #'not symbols)))
  t t)

(deftest find-all-symbols.7
  (let* ((name (make-array '(3) :initial-contents "NIL"
sds's avatar
sds committed
82 83 84
                           :adjustable t
                           :element-type 'character))
         (symbols (find-all-symbols name)))
85 86 87 88 89 90 91
    (values
     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
     (some #'not symbols)))
  t t)

(deftest find-all-symbols.8
  (let* ((type 'character)
sds's avatar
sds committed
92 93 94 95 96 97
         (name0 (make-array '(9) :initial-contents "XYZNILABC"
                            :element-type type))
         (name (make-array '(3) :element-type type
                           :displaced-to name0
                           :displaced-index-offset 3))
         (symbols (find-all-symbols name)))
98 99 100 101 102 103 104
    (values
     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
     (some #'not symbols)))
  t t)

(deftest find-all-symbols.9
  (let* ((type 'base-char)
sds's avatar
sds committed
105 106 107 108 109 110
         (name0 (make-array '(9) :initial-contents "XYZNILABC"
                            :element-type type))
         (name (make-array '(3) :element-type type
                           :displaced-to name0
                           :displaced-index-offset 3))
         (symbols (find-all-symbols name)))
111 112 113
    (values
     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
     (some #'not symbols)))
sds's avatar
sds committed
114
  t t)
115 116 117 118 119 120 121 122 123 124 125 126

;;; Error tests

(deftest find-all-symbols.error.1
  (signals-error (find-all-symbols) program-error)
  t)

(deftest find-all-symbols.error.2
  (signals-error (find-all-symbols "CAR" nil) program-error)
  t)