From 9f829c41651cd2872b1c6e666b5bceeebf829aee Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Wed, 9 Jan 2019 21:13:04 +0000 Subject: Move tests to test --- test/Doctest.hs | 1 + test/Property.hs | 34 ++++++++++++++++++++++++++++++++++ test/Test.hs | 11 +++++++++++ test/Unit.hs | 42 ++++++++++++++++++++++++++++++++++++++++++ test/doctest.json | 5 +++++ 5 files changed, 93 insertions(+) create mode 100644 test/Doctest.hs create mode 100644 test/Property.hs create mode 100644 test/Test.hs create mode 100644 test/Unit.hs create mode 100644 test/doctest.json (limited to 'test') diff --git a/test/Doctest.hs b/test/Doctest.hs new file mode 100644 index 0000000..736ea72 --- /dev/null +++ b/test/Doctest.hs @@ -0,0 +1 @@ +{-# options_ghc -F -pgmF doctest-discover -optF test/doctest.json #-} diff --git a/test/Property.hs b/test/Property.hs new file mode 100644 index 0000000..8fc9020 --- /dev/null +++ b/test/Property.hs @@ -0,0 +1,34 @@ +module Property (propertyTests) where + +import qualified Data.Graph.Inductive as G +import Data.Graph.Inductive.PatriciaTree (Gr) +import Test.Tasty +import qualified Test.Tasty.QuickCheck as QC +import Test.VeriFuzz +import qualified Test.VeriFuzz.Graph.RandomAlt as V + +newtype TestGraph = TestGraph { getGraph :: Gr Gate () } + deriving (Show) + +newtype AltTestGraph = AltTestGraph { getAltGraph :: Gr Gate () } + deriving (Show) + +instance QC.Arbitrary TestGraph where + arbitrary = TestGraph <$> QC.resize 30 randomDAG + +instance QC.Arbitrary AltTestGraph where + arbitrary = AltTestGraph <$> QC.resize 100 V.randomDAG + +simpleGraph = QC.testProperty "simple graph generation check" $ + \graph -> simp graph + where simp = G.isSimple . getGraph + +simpleAltGraph = QC.testProperty "simple alternative graph generation check" $ + \graph -> simp graph + where simp = G.isSimple . getAltGraph + +propertyTests :: TestTree +propertyTests = testGroup "Property Tests" + [ simpleGraph + , simpleAltGraph + ] diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 index 0000000..08a4799 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,11 @@ +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/test/Unit.hs b/test/Unit.hs new file mode 100644 index 0000000..13b9027 --- /dev/null +++ b/test/Unit.hs @@ -0,0 +1,42 @@ +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 "Transformation of AST" $ + assertEqual "Successful transformation" transformExpectedResult + (transformOf traverseExpr trans transformTestData) + ] + +transformTestData :: Expr +transformTestData = BinOp (BinOp (BinOp (Id "id1") BinAnd (Id "id2")) BinAnd + (BinOp (Id "id1") BinAnd (Id "id2"))) BinAnd + (BinOp (BinOp (BinOp (Id "id1") BinAnd (Id "id2")) BinAnd + (BinOp (Id "id1") BinAnd (BinOp (BinOp (Id "id1") BinAnd (Id "id2")) BinAnd + (BinOp (Id "id1") BinAnd (Id "id2"))))) BinOr + (Concat [Concat [ Concat [Id "id1", Id "id2", Id "id2"], Id "id2", Id "id2" + , Concat [Id "id2", Id "id2", Concat [Id "id1", Id "id2"]] + , Id "id2"], Id "id1", Id "id2"])) + +transformExpectedResult :: Expr +transformExpectedResult = BinOp (BinOp (BinOp (Id "id1") BinAnd (Id "Replaced")) BinAnd + (BinOp (Id "id1") BinAnd (Id "Replaced"))) BinAnd + (BinOp (BinOp (BinOp (Id "id1") BinAnd (Id "Replaced")) BinAnd + (BinOp (Id "id1") BinAnd (BinOp (BinOp (Id "id1") BinAnd (Id "Replaced")) BinAnd + (BinOp (Id "id1") BinAnd (Id "Replaced"))))) BinOr + (Concat [Concat [ Concat [Id "id1", Id "Replaced", Id "Replaced"], Id "Replaced", Id "Replaced" + , Concat [Id "Replaced", Id "Replaced", Concat [Id "id1", Id "Replaced"]] + , Id "Replaced"], Id "id1", Id "Replaced"])) + +trans e = + case e of + Id id -> if id == Identifier "id2" then + Id $ Identifier "Replaced" + else Id id + _ -> e diff --git a/test/doctest.json b/test/doctest.json new file mode 100644 index 0000000..d6f5cae --- /dev/null +++ b/test/doctest.json @@ -0,0 +1,5 @@ +{ + "ignore": [], + "sourceFolders": [ "src" ], + "doctestOptions": [ "-XOverloadedStrings" ] +} -- cgit