suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix a bug in the collector (if 'free is a symbol used in the

Browse Source 
mutator, then the 'find-free-space' functions could fail)
This commit is contained in:
Robby Findler 2012-02-20 08:55:03 -06:00
parent b2a3b3a8a2
commit b811adda7c
1 changed files with 20 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/tests/plai/gc2/good-collectors/good-collector.rkt
View File

@ -8,14 +8,24 @@ A collector for use in testing the random mutator generator.
(print-only-errors #t)
;; find-free-space : loc number -> loc or #f
;; start must be a valid pointer
;; (not to the middle of an object)
(define (find-free-space start size)
(cond
[(= start (heap-size))
#f]
[(n-free-blocks? start size)
start]
[(= start (heap-size)) #f]
[else
(find-free-space (+ start 1) size)]))
(case (heap-ref start)
[(free)
(if (n-free-blocks? start size)
start
(find-free-space (+ start 1) size))]
[(flat) (find-free-space (+ start 2) size)]
[(pair) (find-free-space (+ start 3) size)]
[(closure)
(find-free-space (+ start 3 (heap-ref (+ start 2))) size)]
[else
(error 'find-free-space "ack ~s" start)])]))
(define (n-free-blocks? start size)
(cond
@ -49,10 +59,13 @@ A collector for use in testing the random mutator generator.
0)
(test (with-heap #(pair free free)
(find-free-space 0 1))
1)
#f)
(test (with-heap #(pair free free)
(find-free-space 0 2))
1)
#f)
(test (with-heap #(flat free free free)
(find-free-space 0 2))
2)
(test (with-heap #(pair free free)
(find-free-space 0 3))
#f)