From 7397a0fecd2ada90cc9301d32ecdfb4b2a3ad26a Mon Sep 17 00:00:00 2001 From: Joscha Date: Sat, 28 Mar 2020 19:32:15 +0000 Subject: [PATCH] Clean up --- src/Mima/Vm/Flags.hs | 24 ++++---------------- src/Mima/Vm/Metadata.hs | 4 ++-- test/Mima/Vm/FlagSpec.hs | 49 ++++++++++++++++++++-------------------- 3 files changed, 30 insertions(+), 47 deletions(-) diff --git a/src/Mima/Vm/Flags.hs b/src/Mima/Vm/Flags.hs index 8289fa3..1ed6ab9 100644 --- a/src/Mima/Vm/Flags.hs +++ b/src/Mima/Vm/Flags.hs @@ -1,13 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} module Mima.Vm.Flags ( Flags(..) - -- * Methods for interacting with 'Flags' , readonlyAt , executableAt , breakpointAt - -- * Conversion methods for 'Metadata' , flagsFromMetadata - , sampleMeta ) where import qualified Data.Aeson.Types as A @@ -15,13 +12,11 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as T -import Mima.Run import Mima.Vm.Metadata -import Mima.Vm.Storage import Mima.Vm.Word -- | A collection of parsed flags in a more efficient representation than --- 'Metadata' +-- 'Metadata' data Flags = Flags { flagReadonly :: Set.Set MimaAddress , flagExecutable :: Set.Set MimaAddress @@ -38,9 +33,8 @@ instance Monoid Flags where readonlyAt :: Flags -> MimaAddress -> Bool readonlyAt flags address = Set.member address (flagReadonly flags) --- | Checks if a given address has the "executable" flag set. --- If the given 'Flags' has no 'flagExecutable', this method will --- return 'True'. +-- | Checks if a given address has the "executable" flag set. If the given +-- 'Flags' has no 'flagExecutable', this method will return 'True'. executableAt :: Flags -> MimaAddress -> Bool executableAt flags address | Set.null set = True @@ -52,7 +46,6 @@ executableAt flags address breakpointAt :: Flags -> MimaAddress -> Bool breakpointAt flags address = Set.member address (flagBreakpoint flags) - {- Conversion from Metadata -} flagsFromMetadata :: Metadata -> Flags @@ -61,18 +54,9 @@ flagsFromMetadata metadata = where ranges = mdLocal metadata rangesToMap key = mconcat . reverse . map (rangeToMap key) $ ranges - flagSet = Map.keysSet . Map.filter valueToBool . rangesToMap + flagSet = Map.keysSet . Map.filter (/= A.Bool False) . rangesToMap rangeToMap :: T.Text -> Range -> Map.Map MimaAddress A.Value rangeToMap key range = case getMetaInfo range Map.!? key of Nothing -> mempty Just v -> Map.fromList $ zip (getAddresses range) (repeat v) - -valueToBool :: A.Value -> Bool -valueToBool (A.Bool False) = False -valueToBool _ = True - -sampleMeta :: Run Flags -sampleMeta = do - m <- loadMetadata "test/files/FlaggyMetadataFile.json" - pure $ flagsFromMetadata m diff --git a/src/Mima/Vm/Metadata.hs b/src/Mima/Vm/Metadata.hs index c3a8248..74360c3 100644 --- a/src/Mima/Vm/Metadata.hs +++ b/src/Mima/Vm/Metadata.hs @@ -3,8 +3,8 @@ module Mima.Vm.Metadata ( MetaInfo , Range(..) - , getMetaInfo , getAddresses + , getMetaInfo , Metadata(..) ) where @@ -25,7 +25,7 @@ data Range deriving Show getAddresses :: Range -> [MimaAddress] -getAddresses (RangeAt _ address) = [address] +getAddresses (RangeAt _ address) = [address] getAddresses (RangeFromTo _ start stop) = [start..stop] getMetaInfo :: Range -> MetaInfo diff --git a/test/Mima/Vm/FlagSpec.hs b/test/Mima/Vm/FlagSpec.hs index 62529d6..fbaafd9 100644 --- a/test/Mima/Vm/FlagSpec.hs +++ b/test/Mima/Vm/FlagSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} + module Mima.Vm.FlagSpec (spec) where import qualified Data.Aeson.Types as A @@ -22,8 +23,7 @@ breakpointFlags addresses = Flags mempty mempty (Set.fromList addresses) executableBetween :: Bool -> MimaAddress -> MimaAddress -> Metadata executableBetween executable start stop = Metadata mempty - [ - RangeFromTo (Map.fromList [("executable", A.Bool executable)]) start stop + [ RangeFromTo (Map.singleton "executable" (A.Bool executable)) start stop ] overlappingExecutableFlags :: Flags @@ -44,13 +44,13 @@ tripleOverlappingExecutableFlags = flags spec :: Spec spec = do - describe "readonly getter works" $ + describe "readonlyAt" $ it "returns the correct set value" $ do readonlyAt (readOnlyFlags [2, 5]) 2 `shouldBe` True readonlyAt (readOnlyFlags [2, 5]) 5 `shouldBe` True readonlyAt (readOnlyFlags [2, 5]) 3 `shouldBe` False - describe "execute getter works" $ do + describe "executeAt" $ do it "returns the correct set value" $ do executableAt (executeFlags [20, 200]) 2 `shouldBe` False executableAt (executeFlags [20, 200]) 20 `shouldBe` True @@ -58,29 +58,28 @@ spec = do it "returns true if none are set" $ property $ \x -> let word = fromInteger x in executableAt mempty word + context "with nested ranges" $ do + it "returns the correct value for unaffected areas" $ do + let flags = overlappingExecutableFlags + executableAt flags 1 `shouldBe` True + executableAt flags 3 `shouldBe` True + executableAt flags 7 `shouldBe` True + executableAt flags 20 `shouldBe` True + it "returns the correct value for affected areas" $ do + let flags = overlappingExecutableFlags + executableAt flags 4 `shouldBe` False + executableAt flags 5 `shouldBe` False + executableAt flags 6 `shouldBe` False + it "returns the correct value for triple affected areas" $ do + let flags = tripleOverlappingExecutableFlags + executableAt flags 1 `shouldBe` True + executableAt flags 4 `shouldBe` False + executableAt flags 5 `shouldBe` True + executableAt flags 6 `shouldBe` True + executableAt flags 20 `shouldBe` True - describe "breakpoint getter works" $ + describe "breakpointAt" $ it "returns the correct set value" $ do breakpointAt (breakpointFlags [20, 200]) 2 `shouldBe` False breakpointAt (breakpointFlags [20, 200]) 20 `shouldBe` True breakpointAt (breakpointFlags [20, 200]) 200 `shouldBe` True - - context "with nested ranges" $ do - it "returns the correct value for unaffected areas" $ do - let flags = overlappingExecutableFlags - executableAt flags 1 `shouldBe` True - executableAt flags 3 `shouldBe` True - executableAt flags 7 `shouldBe` True - executableAt flags 20 `shouldBe` True - it "returns the correct value for affected areas" $ do - let flags = overlappingExecutableFlags - executableAt flags 4 `shouldBe` False - executableAt flags 5 `shouldBe` False - executableAt flags 6 `shouldBe` False - it "returns the correct value for triple affected areas" $ do - let flags = tripleOverlappingExecutableFlags - executableAt flags 1 `shouldBe` True - executableAt flags 4 `shouldBe` False - executableAt flags 5 `shouldBe` True - executableAt flags 6 `shouldBe` True - executableAt flags 20 `shouldBe` True