added tests to ensure that symbols are gcable.
This commit is contained in:
parent
279618fde2
commit
026fd6f446
|
@ -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)
|
||||||
|
|
|
@ -1 +1 @@
|
||||||
1713
|
1714
|
||||||
|
|
|
@ -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]
|
||||||
;;;
|
;;;
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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)))
|
||||||
|
|
Loading…
Reference in New Issue