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