test-suite/tests/symbols.test

   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 "}")))))