test-suite/tests/symbols.test

   1 ;;;; symbols.test --- test suite for Guile's symbols    -*- scheme -*-
   2 ;;;;
   3 ;;;; Copyright (C) 2001, 2006, 2008, 2009 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   (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
  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))))
  67
  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))))
  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
 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)))
 103
 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)))))
 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
 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"))))))
 133
 134 ;;;
 135 ;;; symbol->string
 136 ;;;
 137
 138 (with-test-prefix "symbol->string"
 139
 140   (pass-if-exception "result is an immutable string"
 141     exception:immutable-string
 142     (string-set! (symbol->string 'abc) 1 #\space)))
 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
 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