syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Improved tests for dataflow.rkt

This commit is contained in:
Tony Garnock-Jones 2016-07-27 06:03:57 -04:00
parent 05325c2699
commit e99cd0887f
1 changed files with 44 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
racket/syndicate/dataflow.rkt
View File

@ -78,7 +78,7 @@
[(define (write-proc c port mode) [(define (write-proc c port mode)
(fprintf port "#<cell:~v>" (cell-value c)))]) (fprintf port "#<cell:~v>" (cell-value c)))])
(define g (make-dataflow-graph)) (define g #f)
(define (R b) (define (R b)
(dataflow-record-observation! g b) (dataflow-record-observation! g b)
@ -95,12 +95,28 @@
(define-syntax-rule (V expr) (define-syntax-rule (V expr)
(letrec ((node (cell #f)) (letrec ((node (cell #f))
(handler (lambda () (handler (lambda ()
(printf "Evaluating ~a\n" 'expr) ;; (printf "Evaluating ~a\n" 'expr)
(W node expr)))) (W node expr))))
(parameterize ((current-dataflow-subject-id handler)) (parameterize ((current-dataflow-subject-id handler))
(handler) (handler)
node))) node)))
(set! g (make-dataflow-graph))
(let* ((c (V 123))
(d (V (* (R c) 2))))
(check-equal? (list (R c) (R d)) (list 123 246))
(dataflow-repair-damage! g repair!)
(check-equal? (list (R c) (R d)) (list 123 246))
(dataflow-repair-damage! g repair!)
(check-equal? (list (R c) (R d)) (list 123 246))
(W c 124)
(check-equal? (list (R c) (R d)) (list 124 246))
(dataflow-repair-damage! g repair!)
(check-equal? (list (R c) (R d)) (list 124 248)))
;; (newline)
(set! g (make-dataflow-graph))
(define xs (V (list 1 2 3 4))) (define xs (V (list 1 2 3 4)))
(define sum (V (foldr + 0 (R xs)))) (define sum (V (foldr + 0 (R xs))))
(define len (V (length (R xs)))) (define len (V (length (R xs))))
@ -114,26 +130,43 @@
(/ (R avg) (R scale)))))) (/ (R avg) (R scale))))))
(define (fix! stage) (define (fix! stage)
(printf "\n----- Stage: ~a\n" stage) ;; (printf "\n----- Stage: ~a\n" stage)
(dataflow-repair-damage! g repair!) (dataflow-repair-damage! g repair!)
(write `((xs ,(R xs)) ;; (write `((xs ,(R xs))
(sum ,(R sum)) ;; (sum ,(R sum))
(len ,(R len)) ;; (len ,(R len))
(avg ,(R avg)) ;; (avg ,(R avg))
(scale ,(R scale)) ;; (scale ,(R scale))
(ans ,(R ans)))) ;; (ans ,(R ans))))
(newline)) ;; (newline)
)
(define-syntax-rule (check-results vs ...)
(check-equal? (map R (list xs sum len avg scale ans)) (list vs ...)))
(fix! 'initial) (fix! 'initial)
(check-results '(1 2 3 4) 10 4 10/4 1 10/4)
(W scale 0) (W scale 0)
(fix! 'scale-zero) (fix! 'scale-zero)
(check-results '(1 2 3 4) 10 4 10/4 0 (void))
(W xs (list* 9 0 (R xs))) (W xs (list* 9 0 (R xs)))
(fix! 'with-nine-and-zero) (fix! 'with-nine-and-zero)
(check-results '(9 0 1 2 3 4) 19 6 19/6 0 (void))
(W xs (list* 5 4 (cddr (R xs)))) (W xs (list* 5 4 (cddr (R xs))))
(fix! 'with-five-and-four) (fix! 'with-five-and-four)
(check-results '(5 4 1 2 3 4) 19 6 19/6 0 (void))
(W scale 1) (W scale 1)
(fix! 'scale-one) (fix! 'scale-one)
(check-results '(5 4 1 2 3 4) 19 6 19/6 1 19/6)
(W xs '()) (W xs '())
(fix! 'empty) (fix! 'empty)
(check-results '() 0 0 (void) 1 #f)
(W xs (list 4 5 6)) (W xs (list 4 5 6))
(fix! 'four-five-six)) (fix! 'four-five-six)
(check-results '(4 5 6) 15 3 15/3 1 15/3))