Commit | Line | Data |
---|---|---|
049fa449 DH |
1 | ;;;; symbols.test --- test suite for Guile's symbols -*- scheme -*- |
2 | ;;;; | |
f5d7662f | 3 | ;;;; Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc. |
049fa449 | 4 | ;;;; |
53befeb7 NJ |
5 | ;;;; This library is free software; you can redistribute it and/or |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
049fa449 | 9 | ;;;; |
53befeb7 | 10 | ;;;; This library is distributed in the hope that it will be useful, |
049fa449 | 11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
53befeb7 NJ |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | ;;;; Lesser General Public License for more details. | |
049fa449 | 14 | ;;;; |
53befeb7 NJ |
15 | ;;;; You should have received a copy of the GNU Lesser General Public |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
049fa449 | 18 | |
fd2b17b9 LC |
19 | (define-module (test-suite test-symbols) |
20 | #:use-module (test-suite lib) | |
21 | #:use-module (ice-9 documentation)) | |
f5e64558 DH |
22 | |
23 | ||
24 | ;;; | |
25 | ;;; miscellaneous | |
26 | ;;; | |
049fa449 | 27 | |
049fa449 | 28 | (define exception:immutable-string |
fd2b17b9 | 29 | (cons 'misc-error "^string is read-only")) |
049fa449 | 30 | |
f5e64558 DH |
31 | (define (documented? object) |
32 | (not (not (object-documentation object)))) | |
33 | ||
f5d7662f MG |
34 | (define (symbol-length s) |
35 | (string-length (symbol->string s))) | |
36 | ||
37 | ;; | |
38 | ;; symbol internals | |
39 | ;; | |
40 | ||
41 | (with-test-prefix "symbol internals" | |
42 | ||
43 | (pass-if "length of new symbol same as stringbuf" | |
44 | (let ((s 'def)) | |
45 | (= (symbol-length s) (assq-ref (%symbol-dump s) 'stringbuf-length)))) | |
46 | ||
47 | (pass-if "contents of new symbol same as stringbuf" | |
48 | (let ((s 'ghi)) | |
49 | (string=? (symbol->string s) | |
50 | (assq-ref (%symbol-dump s) 'stringbuf-chars)))) | |
51 | ||
52 | (pass-if "the null symbol is inlined" | |
53 | (let ((s '#{}#)) | |
54 | (assq-ref (%symbol-dump s) 'stringbuf-inline))) | |
55 | ||
56 | (pass-if "short Latin-1-encoded symbols are inlined" | |
57 | (let ((s 'm)) | |
58 | (assq-ref (%symbol-dump s) 'stringbuf-inline))) | |
59 | ||
60 | (pass-if "long Latin-1-encoded symbols are not inlined" | |
61 | (let ((s 'x0123456789012345678901234567890123456789)) | |
62 | (not (assq-ref (%symbol-dump s) 'stringbuf-inline)))) | |
63 | ||
e23106d5 MG |
64 | (pass-if "short UCS-4-encoded symbols are not inlined" |
65 | (let ((s (string->symbol "\u0100"))) | |
66 | (not (assq-ref (%symbol-dump s) 'stringbuf-inline)))) | |
f5d7662f | 67 | |
e23106d5 MG |
68 | (pass-if "long UCS-4-encoded symbols are not inlined" |
69 | (let ((s (string->symbol "\u010012345678901234567890123456789"))) | |
70 | (not (assq-ref (%symbol-dump s) 'stringbuf-inline)))) | |
f5d7662f MG |
71 | |
72 | (with-test-prefix "hashes" | |
73 | ||
74 | (pass-if "equal symbols have equal hashes" | |
75 | (let ((s1 'mux) | |
76 | (s2 'mux)) | |
77 | (= (assq-ref (%symbol-dump s1) 'hash) | |
78 | (assq-ref (%symbol-dump s2) 'hash)))) | |
79 | ||
80 | (pass-if "different symbols have different hashes" | |
81 | (let ((s1 'mux) | |
82 | (s2 'muy)) | |
83 | (not (= (assq-ref (%symbol-dump s1) 'hash) | |
84 | (assq-ref (%symbol-dump s2) 'hash)))))) | |
85 | ||
86 | (with-test-prefix "encodings" | |
87 | ||
88 | (pass-if "the null symbol is Latin-1 encoded" | |
89 | (let ((s '#{}#)) | |
90 | (not (assq-ref (%symbol-dump s) 'stringbuf-wide)))) | |
91 | ||
92 | (pass-if "ASCII symbols are Latin-1 encoded" | |
93 | (let ((s 'jkl)) | |
94 | (not (assq-ref (%symbol-dump s) 'stringbuf-wide)))) | |
95 | ||
96 | (pass-if "Latin-1 symbols are Latin-1 encoded" | |
97 | (let ((s (string->symbol "\xC0\xC1\xC2"))) | |
98 | (not (assq-ref (%symbol-dump s) 'stringbuf-wide)))) | |
99 | ||
e23106d5 MG |
100 | (pass-if "BMP symbols are UCS-4 encoded" |
101 | (let ((s (string->symbol "\u0100\u0101\x0102"))) | |
102 | (assq-ref (%symbol-dump s) 'stringbuf-wide))) | |
f5d7662f | 103 | |
e23106d5 MG |
104 | (pass-if "SMP symbols are UCS-4 encoded" |
105 | (let ((s (string->symbol "\U010300\u010301\x010302"))) | |
106 | (assq-ref (%symbol-dump s) 'stringbuf-wide))))) | |
f5e64558 DH |
107 | |
108 | ;;; | |
109 | ;;; symbol? | |
110 | ;;; | |
111 | ||
112 | (with-test-prefix "symbol?" | |
113 | ||
114 | (pass-if "documented?" | |
115 | (documented? symbol?)) | |
116 | ||
117 | (pass-if "string" | |
118 | (not (symbol? "foo"))) | |
119 | ||
120 | (pass-if "symbol" | |
121 | (symbol? 'foo))) | |
122 | ||
e23106d5 MG |
123 | ;;; |
124 | ;;; wide symbols | |
125 | ;;; | |
126 | ||
127 | (with-test-prefix "BMP symbols" | |
128 | ||
129 | (pass-if "BMP symbol's string" | |
130 | (and (= 4 (string-length "abc\u0100")) | |
131 | (string=? "abc\u0100" | |
132 | (symbol->string (string->symbol "abc\u0100")))))) | |
f5e64558 DH |
133 | |
134 | ;;; | |
135 | ;;; symbol->string | |
136 | ;;; | |
049fa449 DH |
137 | |
138 | (with-test-prefix "symbol->string" | |
139 | ||
fd2b17b9 | 140 | (pass-if-exception "result is an immutable string" |
049fa449 DH |
141 | exception:immutable-string |
142 | (string-set! (symbol->string 'abc) 1 #\space))) | |
f5e64558 DH |
143 | |
144 | ||
145 | ;;; | |
146 | ;;; gensym | |
147 | ;;; | |
148 | ||
149 | (with-test-prefix "gensym" | |
150 | ||
151 | (pass-if "documented?" | |
152 | (documented? gensym)) | |
153 | ||
154 | (pass-if "produces a symbol" | |
155 | (symbol? (gensym))) | |
156 | ||
157 | (pass-if "produces a fresh symbol" | |
158 | (not (eq? (gensym) (gensym)))) | |
159 | ||
160 | (pass-if "accepts a string prefix" | |
161 | (symbol? (gensym "foo"))) | |
162 | ||
163 | (pass-if-exception "does not accept a symbol prefix" | |
164 | exception:wrong-type-arg | |
24ecf16c MG |
165 | (gensym 'foo)) |
166 | ||
167 | (pass-if "accepts long prefices" | |
168 | (symbol? (gensym (make-string 4000 #\!)))) | |
169 | ||
170 | (pass-if "accepts embedded NULs" | |
171 | (> (string-length (symbol->string (gensym "foo\0bar\0braz\0foo\0bar\0braz\0foo\0bar\0braz\0foo\0bar\0braz\0foo\0bar\0braz\0foo\0bar\0braz\0"))) 6))) | |
172 |