added tests to ensure that symbols are gcable.

scheme/ikarus.symbol-table.ss

@@ -1,9 +1,9 @@
 
 (library (ikarus.symbol-table)
-  (export string->symbol initialize-symbol-table!)
+  (export string->symbol initialize-symbol-table! $symbol-table-size)
   (import 
     (except (ikarus) string->symbol)
-    (ikarus system $symbols))
+    (except (ikarus system $symbols) $symbol-table-size))
 
   (define-struct symbol-table (length mask vec guardian))
   
@@ -91,8 +91,10 @@
         (chain-lookup str idx st (vector-ref v idx)))))
   
   
-  (module (string->symbol initialize-symbol-table!)
+  (module (string->symbol initialize-symbol-table! $symbol-table-size)
     (define st (make-symbol-table 0 3 (make-vector 4 '()) (make-guardian)))
+    (define ($symbol-table-size)
+      (symbol-table-length st))
     (define (string->symbol x)
       (if (string? x)
           (lookup x (string-hash x) st)

scheme/last-revision

@@ -1 +1 @@
-1713
+1714

scheme/makefile.ss

@@ -524,6 +524,7 @@
     [$set-symbol-unique-string!                  $symbols]
     [$set-symbol-plist!                          $symbols]
     [$unintern-gensym                            $symbols]
+    [$symbol-table-size                          $symbols]
     [$init-symbol-value!                         ]
     [$unbound-object?                            $symbols]
     ;;;

scheme/run-tests.ss

@@ -22,7 +22,8 @@
   lists strings bytevectors hashtables fixnums bignums numerics
   bitwise enums pointers sorting io fasl reader case-folding
   parse-flonums string-to-number bignum-to-flonum div-and-mod
-  fldiv-and-mod unicode normalization repl set-position guardians))
+  fldiv-and-mod unicode normalization repl set-position guardians
+  symbol-table))
 
 (define (run-test-from-library x)
   (printf "[testing ~a] ..." x)

scheme/tests/symbol-table.ss

@@ -0,0 +1,19 @@
+
+(library (tests symbol-table)
+  (export run-tests)
+  (import
+    (ikarus) 
+    (only (ikarus system $symbols) $symbol-table-size))
+
+  (define (test-gcable-symbols n)
+    (let ([st1 ($symbol-table-size)])
+      (do ((i 0 (+ i 1))) 
+          ((= i n)) 
+        (string->symbol (number->string i)))
+      (collect)
+      (let ([st2 ($symbol-table-size)])
+        (assert (< (- st2 st1) n)))))
+
+  (define (run-tests)
+    (test-gcable-symbols 1000000)))
+