From bdbe53d5b38b71cdc3045502f16e7ff5a6211f12 Mon Sep 17 00:00:00 2001
From: Hans-Peter Deifel <hpd@hpdeifel.de>
Date: Wed, 1 Feb 2017 16:06:51 +0100
Subject: [PATCH] compare: Add tests for json import
---
osek-verification.cabal | 2 ++
src/Compare/JSON.hs | 6 ++--
test/Compare/JSONSpec.hs | 54 ++++++++++++++++++++++++++++++++++++
test/Compare/MatchingSpec.hs | 2 +-
4 files changed, 60 insertions(+), 4 deletions(-)
create mode 100644 test/Compare/JSONSpec.hs
diff --git a/osek-verification.cabal b/osek-verification.cabal
index 90c0911..dbdd3ef 100644
--- a/osek-verification.cabal
+++ b/osek-verification.cabal
@@ -67,6 +67,7 @@ test-suite spec
, ProtocolSpec
, Search.EpsilonEliminationSpec
, Compare.MatchingSpec
+ , Compare.JSONSpec
build-depends: base >= 4.8 && <4.10
, osek-verification
, hspec >= 2.2.3 && <2.3
@@ -81,5 +82,6 @@ test-suite spec
, here >= 1.2 && < 1.3
, mtl >= 2.2 && <2.3
, utf8-string >= 1.0 && <1.1
+ , fgl >= 5.5 && < 5.6
default-language: Haskell2010
ghc-options: -Wall -fdefer-typed-holes -fno-warn-name-shadowing
diff --git a/src/Compare/JSON.hs b/src/Compare/JSON.hs
index e2e0752..255a46f 100644
--- a/src/Compare/JSON.hs
+++ b/src/Compare/JSON.hs
@@ -4,9 +4,7 @@
{-# OPTIONS_GHC -Wno-orphans #-}
module Compare.JSON
- ( Graph
- , parseFile
- ) where
+ ( parseFile ) where
import Data.Aeson
import Data.Aeson.Types (typeMismatch)
@@ -44,6 +42,8 @@ instance FromJSON E where
E <$> ((\a b c -> (a,b,c)) <$> v .: "from" <*> v .: "to" <*> v .: "label")
parseJSON invalid = typeMismatch "Edge" invalid
+-- TODO Make more robust against input errors
+-- E.g unknown notes in edges
mkGraph :: [NodeLabel] -> [(NodeLabel, NodeLabel, EdgeLabel)] -> NodeLabel -> Graph NodeLabel EdgeLabel
mkGraph nodes labels entry =
let
diff --git a/test/Compare/JSONSpec.hs b/test/Compare/JSONSpec.hs
new file mode 100644
index 0000000..f696721
--- /dev/null
+++ b/test/Compare/JSONSpec.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Compare.JSONSpec (spec) where
+
+import Test.Hspec
+
+import qualified Codec.Binary.UTF8.String as UTF8
+import qualified Data.ByteString.Lazy as BS
+import qualified Data.Graph.Inductive as G
+import Data.Text (Text)
+import qualified Data.Set as S
+
+import Compare.JSON
+import Compare.Types
+
+exampleJson :: BS.ByteString
+exampleJson = BS.pack $ UTF8.encode $ unlines
+ [ "{"
+ , " \"nodes\": ["
+ , " {"
+ , " \"id\": \"ABB15\","
+ , " \"runnable\": \"TaskA\""
+ , " },"
+ , " {"
+ , " \"id\": \"ABB42\","
+ , " \"runnable\": \"TaskB\""
+ , " }"
+ , " ],"
+ , " \"edges\": ["
+ , " {"
+ , " \"from\": \"ABB15\","
+ , " \"to\": \"ABB42\","
+ , " \"label\": \"syscall_a\""
+ , " }"
+ , " ],"
+ , " \"entry\": \"ABB15\""
+ , "}"
+ ]
+
+spec :: Spec
+spec = describe "parseFile" $
+ it "parses an example" $
+ case parseFile exampleJson :: Either String (Graph Text Text) of
+ Left err -> expectationFailure err
+ Right g ->
+ let
+ nodes = S.fromList $ map snd $ G.labNodes (graph g)
+ edges = map (\(n1, n2, l) -> (G.lab (graph g) n1, G.lab (graph g) n2, l)) $
+ G.labEdges (graph g)
+ entry = G.lab (graph g) (point g)
+ in do
+ nodes `shouldBe` (S.fromList ["ABB15", "ABB42"])
+ edges `shouldBe` [(Just "ABB15", Just "ABB42", "syscall_a")]
+ entry `shouldBe` Just "ABB15"
diff --git a/test/Compare/MatchingSpec.hs b/test/Compare/MatchingSpec.hs
index 7728aac..ee7703d 100644
--- a/test/Compare/MatchingSpec.hs
+++ b/test/Compare/MatchingSpec.hs
@@ -6,7 +6,7 @@ import Test.QuickCheck
import qualified Compare.Matching as M
spec :: Spec
-spec = describe "Matching" $ do
+spec = do
emptySpec
lookupSpec
--
GitLab