1;;;; symbols.test --- test suite for Guile's symbols    -*- scheme -*-
2;;;;
3;;;; Copyright (C) 2001, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
4;;;;
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.
9;;;;
10;;;; This library is distributed in the hope that it will be useful,
11;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13;;;; Lesser General Public License for more details.
14;;;;
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
18
19(define-module (test-suite test-symbols)
20  #:use-module (test-suite lib)
21  #:use-module (ice-9 documentation))
22
23
24;;;
25;;; miscellaneous
26;;;
27
28(define exception:immutable-string
29  (cons 'misc-error "^string is read-only"))
30
31(define (documented? object)
32  (not (not (object-documentation object))))
33
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
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
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)))
84
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)))))
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
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"))))))
114
115;;;
116;;; symbol->string
117;;;
118
119(with-test-prefix "symbol->string"
120
121  (pass-if-exception "result is an immutable string"
122    exception:immutable-string
123    (string-set! (symbol->string 'abc) 1 #\space)))
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
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
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 "}")))))
159