conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

added tests to ensure that symbols are gcable.

This commit is contained in:
Abdulaziz Ghuloum 2008-12-10 03:18:33 -05:00
parent 279618fde2
commit 026fd6f446
5 changed files with 28 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
scheme/ikarus.symbol-table.ss
View File

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

2
scheme/last-revision
View File

@ -1 +1 @@
1713 1714

1
scheme/makefile.ss
View File

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

3
scheme/run-tests.ss
View File

@ -22,7 +22,8 @@
lists strings bytevectors hashtables fixnums bignums numerics lists strings bytevectors hashtables fixnums bignums numerics
bitwise enums pointers sorting io fasl reader case-folding bitwise enums pointers sorting io fasl reader case-folding
parse-flonums string-to-number bignum-to-flonum div-and-mod 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) (define (run-test-from-library x)
(printf "[testing ~a] ..." x) (printf "[testing ~a] ..." x)

19
scheme/tests/symbol-table.ss Normal file
View File

@ -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)))