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   ;; symbol->string isn't ready for UCS-4 yet
  65
  66   ;;(pass-if "short UCS-4-encoded symbols are not inlined"
  67   ;;  (let ((s (string->symbol "\u0100")))
  68   ;;    (not (assq-ref (%symbol-dump s) 'stringbuf-inline))))
  69
  70   ;;(pass-if "long UCS-4-encoded symbols are not inlined"
  71   ;;  (let ((s (string->symbol "\u010012345678901234567890123456789")))
  72   ;;    (not (assq-ref (%symbol-dump s) 'stringbuf-inline))))
  73
  74   (with-test-prefix "hashes"
  75
  76     (pass-if "equal symbols have equal hashes"
  77       (let ((s1 'mux)
  78             (s2 'mux))
  79         (= (assq-ref (%symbol-dump s1) 'hash)
  80            (assq-ref (%symbol-dump s2) 'hash))))
  81
  82     (pass-if "different symbols have different hashes"
  83       (let ((s1 'mux)
  84             (s2 'muy))
  85         (not (= (assq-ref (%symbol-dump s1) 'hash)
  86                 (assq-ref (%symbol-dump s2) 'hash))))))
  87
  88   (with-test-prefix "encodings"
  89
  90     (pass-if "the null symbol is Latin-1 encoded"
  91       (let ((s '#{}#))
  92         (not (assq-ref (%symbol-dump s) 'stringbuf-wide))))
  93
  94     (pass-if "ASCII symbols are Latin-1 encoded"
  95       (let ((s 'jkl))
  96         (not (assq-ref (%symbol-dump s) 'stringbuf-wide))))
  97
  98     (pass-if "Latin-1 symbols are Latin-1 encoded"
  99       (let ((s (string->symbol "\xC0\xC1\xC2")))
 100         (not (assq-ref (%symbol-dump s) 'stringbuf-wide))))
 101
 102     ;; symbol->string isn't ready for UCS-4 yet
 103
 104     ;;(pass-if "BMP symbols are UCS-4 encoded"
 105     ;;  (let ((s (string->symbol "\u0100\u0101\x0102")))
 106     ;;    (assq-ref (%symbol-dump s) 'stringbuf-wide)))
 107
 108     ;;(pass-if "SMP symbols are UCS-4 encoded"
 109     ;;  (let ((s (string->symbol "\U010300\u010301\x010302")))
 110     ;;    (assq-ref (%symbol-dump s) 'stringbuf-wide)))
 111     ))
 112
 113 ;;;
 114 ;;; symbol?
 115 ;;;
 116
 117 (with-test-prefix "symbol?"
 118
 119   (pass-if "documented?"
 120     (documented? symbol?))
 121
 122   (pass-if "string"
 123     (not (symbol? "foo")))
 124
 125   (pass-if "symbol"
 126     (symbol? 'foo)))
 127
 128
 129 ;;;
 130 ;;; symbol->string
 131 ;;;
 132
 133 (with-test-prefix "symbol->string"
 134
 135   (pass-if-exception "result is an immutable string"
 136     exception:immutable-string
 137     (string-set! (symbol->string 'abc) 1 #\space)))
 138
 139
 140 ;;;
 141 ;;; gensym
 142 ;;;
 143
 144 (with-test-prefix "gensym"
 145
 146   (pass-if "documented?"
 147     (documented? gensym))
 148
 149   (pass-if "produces a symbol"
 150     (symbol? (gensym)))
 151
 152   (pass-if "produces a fresh symbol"
 153     (not (eq? (gensym) (gensym))))
 154
 155   (pass-if "accepts a string prefix"
 156     (symbol? (gensym "foo")))
 157
 158   (pass-if-exception "does not accept a symbol prefix"
 159     exception:wrong-type-arg
 160     (gensym 'foo))
 161
 162   (pass-if "accepts long prefices"
 163     (symbol? (gensym (make-string 4000 #\!))))
 164
 165   (pass-if "accepts embedded NULs"
 166     (> (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)))
 167