From 434c2828ab622c4b9d07a1f1a8a09ede0696f4e0 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <ymherklotz@gmail.com>
Date: Sun, 23 Dec 2018 11:27:11 +0000
Subject: Add unit tests for the traversal

---
 tests/Property.hs |  2 +-
 tests/Test.hs     |  2 +-
 tests/Unit.hs     | 50 ++++++++++++++++++++++++++++++++++++++++++++------
 3 files changed, 46 insertions(+), 8 deletions(-)

(limited to 'tests')

diff --git a/tests/Property.hs b/tests/Property.hs
index 88330bd..55b7f31 100644
--- a/tests/Property.hs
+++ b/tests/Property.hs
@@ -9,7 +9,7 @@ newtype TestGraph = TestGraph { getGraph :: Gr Gate () }
                   deriving (Show)
 
 instance QC.Arbitrary TestGraph where
-  arbitrary = TestGraph <$> randomDAG 100
+  arbitrary = TestGraph <$> randomDAG 30
 
 simpleGraph = QC.testProperty "simple graph generation" $
   \graph -> simp (graph :: TestGraph)
diff --git a/tests/Test.hs b/tests/Test.hs
index c234b90..08a4799 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -2,10 +2,10 @@ module Main where
 
 import           Property
 import           Test.Tasty
+import           Test.VeriFuzz
 import           Unit
 
 tests :: TestTree
 tests = testGroup "Tests" [unitTests, propertyTests]
 
 main = defaultMain tests
-
diff --git a/tests/Unit.hs b/tests/Unit.hs
index a04098b..976f23b 100644
--- a/tests/Unit.hs
+++ b/tests/Unit.hs
@@ -1,13 +1,51 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Unit (unitTests) where
 
+import           Control.Lens
+import qualified Data.Graph.Inductive as G
+import           Data.Text            (Text)
+import qualified Data.Text            as T
 import           Test.Tasty
 import           Test.Tasty.HUnit
+import           Test.VeriFuzz
 
 unitTests = testGroup "Unit tests"
-  [ testCase "List comparison (different length)" $
-      [1, 2, 3] `compare` [1,2] @?= GT
-
-  -- the following test does not hold
-  , testCase "List comparison (same length)" $
-      [1, 2, 3] `compare` [1,2,2] @?= GT
+  [ testCase "Transformation of AST" $
+      assertEqual "Successful transformation" transformExpectedResult
+      (transformOf traverseExpr trans transformTestData)
   ]
+
+primExpr :: Text -> Expression
+primExpr = PrimExpr . PrimId . Identifier
+
+transformTestData :: Expression
+transformTestData = OpExpr (OpExpr (OpExpr (primExpr "id1") BinAnd (primExpr "id2")) BinAnd
+                            (OpExpr (primExpr "id1") BinAnd (primExpr "id2"))) BinAnd
+                    (OpExpr (OpExpr (primExpr "id1") BinAnd (primExpr "id2")) BinAnd
+                     (OpExpr (primExpr "id1") BinAnd (OpExpr (OpExpr (primExpr "id1") BinAnd (primExpr "id2")) BinAnd
+                                                      (OpExpr (primExpr "id1") BinAnd (primExpr "id2")))))
+
+transformExpectedResult :: Expression
+transformExpectedResult = OpExpr (OpExpr (OpExpr (primExpr "id1") BinAnd (primExpr "Replaced")) BinAnd
+                                  (OpExpr (primExpr "id1") BinAnd (primExpr "Replaced"))) BinAnd
+                          (OpExpr (OpExpr (primExpr "id1") BinAnd (primExpr "Replaced")) BinAnd
+                           (OpExpr (primExpr "id1") BinAnd (OpExpr (OpExpr (primExpr "id1") BinAnd
+                                                                    (primExpr "Replaced")) BinAnd
+                                                            (OpExpr (primExpr "id1") BinAnd (primExpr "Replaced")))))
+
+trans e =
+  case e of
+    PrimExpr (PrimId id) -> if id == Identifier "id2" then
+                              PrimExpr . PrimId $ Identifier "Replaced"
+                            else PrimExpr (PrimId id)
+    _                    -> e
+
+runMain = do
+  gr <- genRandomDAG 100 :: IO (G.Gr Gate ())
+--  _ <- runGraphviz (graphToDot quickParams $ emap (const "") gr) Png "output.png",
+--  T.putStrLn $ generate gr
+  --g <- QC.generate (QC.arbitrary :: QC.Gen SourceText)
+  let x = generateAST $ Circuit gr
+  let y = head . reverse $ x ^.. getSourceText . traverse . getDescription . moduleItems . traverse . _Assign . contAssignExpr
+  print $ transformOf traverseExpr trans y
-- 
cgit