Improved tests for dataflow.rkt

racket/syndicate/dataflow.rkt

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