OSDN Git Service

[1] Some tests for 'calc' and 'truth-table' were added.
authorU-tackya-PC\tackya <yammouch@users.sourceforge.jp>
Mon, 3 Jan 2011 12:17:43 +0000 (21:17 +0900)
committerU-tackya-PC\tackya <yammouch@users.sourceforge.jp>
Mon, 3 Jan 2011 12:17:43 +0000 (21:17 +0900)
modified:   test-graph-generator.lisp

test/test-graph-generator.lisp

index 3868d63..d1b5f5f 100755 (executable)
 ;;                            (list o)
 ;;                            `((i0 . 1) (i1 . 1)))
 ;;                 '(1))))
-;
-;(ggen::reset-graph)
-;(let* ((truth-table '(((0 0 0) (0 0))
-;                      ((1 0 0) (1 0))
-;                      ((0 1 0) (1 0))
-;                      ((1 1 0) (0 1))
-;                      ((0 0 1) (1 0))
-;                      ((1 0 1) (0 1))
-;                      ((0 1 1) (0 1))
-;                      ((1 1 1) (1 1))))
-;       (ins (mapcar #'ggen:input '(a b cin)))
-;       (oes (ggen:truth-table truth-table ins))
-;       (os (mapcar #'ggen:output oes '(s cout)))
-;       (graph ggen:*graph*))
-;  (dolist (row truth-table)
-;    (let ((ans (ggen:calc graph
-;                          (mapcar #'cons '(a b cin) (car row)))))
-;      (assert
-;        (and (eql (cdr (assoc 's ans))
-;                  (car (cadr row)))
-;             (eql (cdr (assoc 'cout ans))
-;                  (cadr (cadr row))))
-;         nil
-;         "An error occured on ~A in truth-table-test" row))))
-;
+
+(ggen::reset-graph)
+(let* ((truth-table '(((0 0 0) (0 0))
+                      ((1 0 0) (1 0))
+                      ((0 1 0) (1 0))
+                      ((1 1 0) (0 1))
+                      ((0 0 1) (1 0))
+                      ((1 0 1) (0 1))
+                      ((0 1 1) (0 1))
+                      ((1 1 1) (1 1))))
+       (ins (mapcar #'ggen:input '(a b cin)))
+       (oes (ggen:truth-table truth-table ins))
+       (os (mapcar #'ggen:output oes '(s cout)))
+       (graph ggen:*graph*))
+  (dolist (row truth-table)
+    (let ((ans (ggen:calc graph
+                          (mapcar #'cons '(a b cin) (car row)))))
+      (assert
+        (and (eql (cdr (assoc 's ans))
+                  (car (cadr row)))
+             (eql (cdr (assoc 'cout ans))
+                  (cadr (cadr row))))
+         nil
+         "An error occured on ~A in truth-table-test" row))))
+
 ;; tests for 'elim1-orn-1in'
 ;(ggen::reset-graph)
 ;(let ((a (input 'a)))