diff --git a/osek-verification.cabal b/osek-verification.cabal index 90c0911d42959062d0d9a0d2c8ec5573f4d7fced..dbdd3ef44f4979038305e635e1f02233f3096ad3 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 e2e0752d39f8d93cc98857e75015d81acb52859f..255a46f2a30aa105b486b76f026bdd20695fcb6a 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 0000000000000000000000000000000000000000..f6967214f370e90657c716ecdf537c163b64e58c --- /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 7728aac309a39e8d801ed2f210618610a8f01d4b..ee7703db6254d76feffdbd5a11d4ef617ebce2e7 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