Commit | Line | Data |
---|---|---|
049fa449 DH |
1 | ;;;; symbols.test --- test suite for Guile's symbols -*- scheme -*- |
2 | ;;;; | |
fd2b17b9 | 3 | ;;;; Copyright (C) 2001, 2006, 2008 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 | ||
34 | ||
35 | ;;; | |
36 | ;;; symbol? | |
37 | ;;; | |
38 | ||
39 | (with-test-prefix "symbol?" | |
40 | ||
41 | (pass-if "documented?" | |
42 | (documented? symbol?)) | |
43 | ||
44 | (pass-if "string" | |
45 | (not (symbol? "foo"))) | |
46 | ||
47 | (pass-if "symbol" | |
48 | (symbol? 'foo))) | |
49 | ||
50 | ||
51 | ;;; | |
52 | ;;; symbol->string | |
53 | ;;; | |
049fa449 DH |
54 | |
55 | (with-test-prefix "symbol->string" | |
56 | ||
fd2b17b9 | 57 | (pass-if-exception "result is an immutable string" |
049fa449 DH |
58 | exception:immutable-string |
59 | (string-set! (symbol->string 'abc) 1 #\space))) | |
f5e64558 DH |
60 | |
61 | ||
62 | ;;; | |
63 | ;;; gensym | |
64 | ;;; | |
65 | ||
66 | (with-test-prefix "gensym" | |
67 | ||
68 | (pass-if "documented?" | |
69 | (documented? gensym)) | |
70 | ||
71 | (pass-if "produces a symbol" | |
72 | (symbol? (gensym))) | |
73 | ||
74 | (pass-if "produces a fresh symbol" | |
75 | (not (eq? (gensym) (gensym)))) | |
76 | ||
77 | (pass-if "accepts a string prefix" | |
78 | (symbol? (gensym "foo"))) | |
79 | ||
80 | (pass-if-exception "does not accept a symbol prefix" | |
81 | exception:wrong-type-arg | |
24ecf16c MG |
82 | (gensym 'foo)) |
83 | ||
84 | (pass-if "accepts long prefices" | |
85 | (symbol? (gensym (make-string 4000 #\!)))) | |
86 | ||
87 | (pass-if "accepts embedded NULs" | |
88 | (> (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))) | |
89 |