source: trunk/source/tests/ansi-tests/find-all-symbols.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.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Feb 22 07:10:22 2004
4;;;; Contains: Tests for FIND-ALL-SYMBOLS
5
6(in-package :cl-test)
7
8(deftest find-all-symbols.1
9  (let ((all-packages (list-all-packages)))
10    (loop
11     for package in all-packages
12     append
13     (let ((failures nil))
14       (do-symbols (sym package failures)
15         (when (eql (symbol-package sym) package)
16           (let* ((name (symbol-name sym))
17                  (similar (find-all-symbols name))
18                  (similar2 (find-all-symbols sym)))
19             (unless (and (member sym similar)
20                          (subsetp similar similar2)
21                          (subsetp similar2 similar)
22                          (loop for sym2 in similar
23                                always (string= name (symbol-name sym2))))
24               (push sym failures))))))))
25  nil)
26
27;;; FIXME -- test that each symbol found is accessible in some package
28
29(deftest find-all-symbols.2
30  (loop for i from 0 to 255
31        for c = (code-char i)
32        when (and (characterp c)
33                  (loop for sym in (find-all-symbols c)
34                        thereis (not (string= (symbol-name sym)
35                                              (string c)))))
36        collect c)
37  nil)
38
39;;; Unusual strings
40
41(deftest find-all-symbols.3
42  (let* ((name (make-array '(3) :initial-contents "NIL"
43                           :element-type 'base-char))
44         (symbols (find-all-symbols name)))
45    (values
46     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
47     (some #'not symbols)))
48  t t)
49
50(deftest find-all-symbols.4
51  (let* ((name (make-array '(5) :initial-contents "NILXY"
52                           :fill-pointer 3
53                           :element-type 'character))
54         (symbols (find-all-symbols name)))
55    (values
56     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
57     (some #'not symbols)))
58  t t)
59
60(deftest find-all-symbols.5
61  (let* ((name (make-array '(5) :initial-contents "NILXY"
62                           :fill-pointer 3
63                           :element-type 'base-char))
64         (symbols (find-all-symbols name)))
65    (values
66     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
67     (some #'not symbols)))
68  t t)
69
70(deftest find-all-symbols.6
71  (let* ((name (make-array '(3) :initial-contents "NIL"
72                           :adjustable t
73                           :element-type 'base-char))
74         (symbols (find-all-symbols name)))
75    (values
76     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
77     (some #'not symbols)))
78  t t)
79
80(deftest find-all-symbols.7
81  (let* ((name (make-array '(3) :initial-contents "NIL"
82                           :adjustable t
83                           :element-type 'character))
84         (symbols (find-all-symbols name)))
85    (values
86     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
87     (some #'not symbols)))
88  t t)
89
90(deftest find-all-symbols.8
91  (let* ((type 'character)
92         (name0 (make-array '(9) :initial-contents "XYZNILABC"
93                            :element-type type))
94         (name (make-array '(3) :element-type type
95                           :displaced-to name0
96                           :displaced-index-offset 3))
97         (symbols (find-all-symbols name)))
98    (values
99     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
100     (some #'not symbols)))
101  t t)
102
103(deftest find-all-symbols.9
104  (let* ((type 'base-char)
105         (name0 (make-array '(9) :initial-contents "XYZNILABC"
106                            :element-type type))
107         (name (make-array '(3) :element-type type
108                           :displaced-to name0
109                           :displaced-index-offset 3))
110         (symbols (find-all-symbols name)))
111    (values
112     (notnot (every #'(lambda (s) (string= (symbol-name s) "NIL")) symbols))
113     (some #'not symbols)))
114  t t) 
115
116;;; Error tests
117
118(deftest find-all-symbols.error.1
119  (signals-error (find-all-symbols) program-error)
120  t)
121
122(deftest find-all-symbols.error.2
123  (signals-error (find-all-symbols "CAR" nil) program-error)
124  t)
125
126
Note: See TracBrowser for help on using the repository browser.