More string and symbol tests

        * test-suite/tests/strings.test: more tests

        * test-suite/tests/symbols.test: more tests

1 files changed, 79 insertions, 1 deletions

diff --git a/test-suite/tests/symbols.test b/test-suite/tests/symbols.test
index 5be2743b2..3b1abe1e9 100644
--- a/test-suite/tests/symbols.test
+++ b/test-suite/tests/symbols.test
@@ -1,6 +1,6 @@
 ;;;; symbols.test --- test suite for Guile's symbols    -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2001, 2006, 2008 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2008, 2009 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -31,6 +31,84 @@
 (define (documented? object)
   (not (not (object-documentation object))))
 
+(define (symbol-length s)
+  (string-length (symbol->string s)))
+
+;;
+;; symbol internals
+;;
+
+(with-test-prefix "symbol internals"
+
+  (pass-if "length of new symbol same as stringbuf"
+    (let ((s 'def))
+      (= (symbol-length s) (assq-ref (%symbol-dump s) 'stringbuf-length))))
+
+  (pass-if "contents of new symbol same as stringbuf"
+    (let ((s 'ghi))
+      (string=? (symbol->string s) 
+                (assq-ref (%symbol-dump s) 'stringbuf-chars))))
+
+  (pass-if "the null symbol is inlined"
+    (let ((s '#{}#))
+      (assq-ref (%symbol-dump s) 'stringbuf-inline)))
+
+  (pass-if "short Latin-1-encoded symbols are inlined"
+    (let ((s 'm))
+      (assq-ref (%symbol-dump s) 'stringbuf-inline)))
+
+  (pass-if "long Latin-1-encoded symbols are not inlined"
+    (let ((s 'x0123456789012345678901234567890123456789))
+      (not (assq-ref (%symbol-dump s) 'stringbuf-inline))))
+
+  ;; symbol->string isn't ready for UCS-4 yet
+
+  ;;(pass-if "short UCS-4-encoded symbols are not inlined"
+  ;;  (let ((s (string->symbol "\u0100")))
+  ;;    (not (assq-ref (%symbol-dump s) 'stringbuf-inline))))
+
+  ;;(pass-if "long UCS-4-encoded symbols are not inlined"
+  ;;  (let ((s (string->symbol "\u010012345678901234567890123456789")))
+  ;;    (not (assq-ref (%symbol-dump s) 'stringbuf-inline))))
+
+  (with-test-prefix "hashes"
+  
+    (pass-if "equal symbols have equal hashes"
+      (let ((s1 'mux)
+            (s2 'mux))
+        (= (assq-ref (%symbol-dump s1) 'hash)
+           (assq-ref (%symbol-dump s2) 'hash))))
+
+    (pass-if "different symbols have different hashes"
+      (let ((s1 'mux)
+            (s2 'muy))
+        (not (= (assq-ref (%symbol-dump s1) 'hash)
+                (assq-ref (%symbol-dump s2) 'hash))))))
+
+  (with-test-prefix "encodings"
+
+    (pass-if "the null symbol is Latin-1 encoded"
+      (let ((s '#{}#))
+        (not (assq-ref (%symbol-dump s) 'stringbuf-wide))))
+
+    (pass-if "ASCII symbols are Latin-1 encoded"
+      (let ((s 'jkl))
+        (not (assq-ref (%symbol-dump s) 'stringbuf-wide))))
+
+    (pass-if "Latin-1 symbols are Latin-1 encoded"
+      (let ((s (string->symbol "\xC0\xC1\xC2")))
+        (not (assq-ref (%symbol-dump s) 'stringbuf-wide))))
+
+    ;; symbol->string isn't ready for UCS-4 yet
+
+    ;;(pass-if "BMP symbols are UCS-4 encoded"
+    ;;  (let ((s (string->symbol "\u0100\u0101\x0102")))
+    ;;    (assq-ref (%symbol-dump s) 'stringbuf-wide)))
+
+    ;;(pass-if "SMP symbols are UCS-4 encoded"
+    ;;  (let ((s (string->symbol "\U010300\u010301\x010302")))
+    ;;    (assq-ref (%symbol-dump s) 'stringbuf-wide)))
+    ))
 
 ;;;
 ;;; symbol?