Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 04:55:04 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Additional tests

Browse source
This commit is contained in:
Justin Ethier 2019-01-06 21:54:44 -05:00
parent 3ce15462dc
commit 82c7170247
1 changed files with 33 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
cps-opt-analyze-call-graph-test.scm
View file

@ -28,17 +28,43 @@
(set-cdr! queue entry) (set-cdr! queue entry)
x)) x))
(define (pos-in-list x l)
(let loop ((l l) (i 0))
(cond ((not (pair? l)) #f)
((eq? (car l) x) i)
(else (loop (cdr l) (+ i 1))))))
(define (test obj) (define (proc-obj-code obj) (vector-ref obj 3))
(let ((m (length (queue->list objects-dumped))))
(queue-put! objects-dumped obj) (define (proc-obj? x)
(queue-put! object-queue obj) (and (vector? x)
m) (> (vector-length x) 0)
) (eq? (vector-ref x 0) proc-obj-tag)))
(define proc-obj-tag (list 'proc-obj))
(define (test obj)
(if (and (proc-obj? obj) (not (proc-obj-code obj)))
#f
(let ((n (pos-in-list obj (queue->list objects-dumped))))
(if n
n
(let ((m (length (queue->list objects-dumped))))
(queue-put! objects-dumped obj)
(queue-put! object-queue obj)
m)))))
;(define (test obj)
; (let ((m (length (queue->list objects-dumped))))
; (queue-put! objects-dumped obj)
; (queue-put! object-queue obj)
; m)
;)
(queue-put! objects-dumped 'a) (queue-put! objects-dumped 'a)
(queue-put! objects-dumped 'b) (queue-put! objects-dumped 'b)
(write (queue->list objects-dumped)) (write (queue->list objects-dumped))
(write (test 'c)) (write (test 'c))
(write (my-not (test 'd))) (write (my-not (test 'd)))
(write (my-string<=? (symbol->string (car objects-dumped)))) ;(write (my-string<=? (symbol->string (car objects-dumped))))