Commit | Line | Data |
---|---|---|
049fa449 DH |
1 | ;;;; symbols.test --- test suite for Guile's symbols -*- scheme -*- |
2 | ;;;; | |
2e9fc9fc | 3 | ;;;; Copyright (C) 2001, 2006, 2008, 2009, 2011 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 | ||
f5d7662f MG |
52 | |
53 | (with-test-prefix "hashes" | |
54 | ||
55 | (pass-if "equal symbols have equal hashes" | |
56 | (let ((s1 'mux) | |
57 | (s2 'mux)) | |
58 | (= (assq-ref (%symbol-dump s1) 'hash) | |
59 | (assq-ref (%symbol-dump s2) 'hash)))) | |
60 | ||
61 | (pass-if "different symbols have different hashes" | |
62 | (let ((s1 'mux) | |
63 | (s2 'muy)) | |
64 | (not (= (assq-ref (%symbol-dump s1) 'hash) | |
65 | (assq-ref (%symbol-dump s2) 'hash)))))) | |
66 | ||
67 | (with-test-prefix "encodings" | |
68 | ||
69 | (pass-if "the null symbol is Latin-1 encoded" | |
70 | (let ((s '#{}#)) | |
71 | (not (assq-ref (%symbol-dump s) 'stringbuf-wide)))) | |
72 | ||
73 | (pass-if "ASCII symbols are Latin-1 encoded" | |
74 | (let ((s 'jkl)) | |
75 | (not (assq-ref (%symbol-dump s) 'stringbuf-wide)))) | |
76 | ||
77 | (pass-if "Latin-1 symbols are Latin-1 encoded" | |
78 | (let ((s (string->symbol "\xC0\xC1\xC2"))) | |
79 | (not (assq-ref (%symbol-dump s) 'stringbuf-wide)))) | |
80 | ||
e23106d5 MG |
81 | (pass-if "BMP symbols are UCS-4 encoded" |
82 | (let ((s (string->symbol "\u0100\u0101\x0102"))) | |
83 | (assq-ref (%symbol-dump s) 'stringbuf-wide))) | |
f5d7662f | 84 | |
e23106d5 MG |
85 | (pass-if "SMP symbols are UCS-4 encoded" |
86 | (let ((s (string->symbol "\U010300\u010301\x010302"))) | |
87 | (assq-ref (%symbol-dump s) 'stringbuf-wide))))) | |
f5e64558 DH |
88 | |
89 | ;;; | |
90 | ;;; symbol? | |
91 | ;;; | |
92 | ||
93 | (with-test-prefix "symbol?" | |
94 | ||
95 | (pass-if "documented?" | |
96 | (documented? symbol?)) | |
97 | ||
98 | (pass-if "string" | |
99 | (not (symbol? "foo"))) | |
100 | ||
101 | (pass-if "symbol" | |
102 | (symbol? 'foo))) | |
103 | ||
e23106d5 MG |
104 | ;;; |
105 | ;;; wide symbols | |
106 | ;;; | |
107 | ||
108 | (with-test-prefix "BMP symbols" | |
109 | ||
110 | (pass-if "BMP symbol's string" | |
111 | (and (= 4 (string-length "abc\u0100")) | |
112 | (string=? "abc\u0100" | |
113 | (symbol->string (string->symbol "abc\u0100")))))) | |
f5e64558 DH |
114 | |
115 | ;;; | |
116 | ;;; symbol->string | |
117 | ;;; | |
049fa449 DH |
118 | |
119 | (with-test-prefix "symbol->string" | |
120 | ||
fd2b17b9 | 121 | (pass-if-exception "result is an immutable string" |
049fa449 DH |
122 | exception:immutable-string |
123 | (string-set! (symbol->string 'abc) 1 #\space))) | |
f5e64558 DH |
124 | |
125 | ||
126 | ;;; | |
127 | ;;; gensym | |
128 | ;;; | |
129 | ||
130 | (with-test-prefix "gensym" | |
131 | ||
132 | (pass-if "documented?" | |
133 | (documented? gensym)) | |
134 | ||
135 | (pass-if "produces a symbol" | |
136 | (symbol? (gensym))) | |
137 | ||
138 | (pass-if "produces a fresh symbol" | |
139 | (not (eq? (gensym) (gensym)))) | |
140 | ||
141 | (pass-if "accepts a string prefix" | |
142 | (symbol? (gensym "foo"))) | |
143 | ||
144 | (pass-if-exception "does not accept a symbol prefix" | |
145 | exception:wrong-type-arg | |
24ecf16c MG |
146 | (gensym 'foo)) |
147 | ||
148 | (pass-if "accepts long prefices" | |
149 | (symbol? (gensym (make-string 4000 #\!)))) | |
150 | ||
151 | (pass-if "accepts embedded NULs" | |
152 | (> (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))) | |
153 | ||
2e9fc9fc AW |
154 | (with-test-prefix "extended read syntax" |
155 | (pass-if (equal? "#{}#" (object->string (string->symbol "")))) | |
156 | (pass-if (equal? "a" (object->string (string->symbol "a")))) | |
157 | (pass-if (equal? "#{a b}#" (object->string (string->symbol "a b")))) | |
158 | (pass-if (equal? "#{\\x7d;}#" (object->string (string->symbol "}"))))) |