From d5d1d87fd5fcf3ef7392ee39eba68979acfbf5c1 Mon Sep 17 00:00:00 2001 From: Tristan Ravitch Date: Thu, 9 Nov 2017 10:43:41 -0800 Subject: [PATCH] Split some shared helpers out of a test module --- macaw-ppc/macaw-ppc.cabal | 1 + macaw-ppc/tests/PPC64Tests.hs | 43 ++------------------------- macaw-ppc/tests/Shared.hs | 55 +++++++++++++++++++++++++++++++++++ 3 files changed, 58 insertions(+), 41 deletions(-) create mode 100644 macaw-ppc/tests/Shared.hs diff --git a/macaw-ppc/macaw-ppc.cabal b/macaw-ppc/macaw-ppc.cabal index e64a8f8b..59fed4d8 100644 --- a/macaw-ppc/macaw-ppc.cabal +++ b/macaw-ppc/macaw-ppc.cabal @@ -57,6 +57,7 @@ test-suite macaw-ppc-tests ghc-options: -Wall main-is: Main.hs other-modules: PPC64Tests + Shared hs-source-dirs: tests build-depends: base >=4.9 && <5, bytestring, diff --git a/macaw-ppc/tests/PPC64Tests.hs b/macaw-ppc/tests/PPC64Tests.hs index e5ac108e..51e34b5c 100644 --- a/macaw-ppc/tests/PPC64Tests.hs +++ b/macaw-ppc/tests/PPC64Tests.hs @@ -8,13 +8,10 @@ module PPC64Tests ( ) where import Control.Lens ( (^.) ) -import qualified Control.Monad.Catch as C -import qualified Data.ByteString as B import qualified Data.Foldable as F import qualified Data.Map as M import Data.Maybe ( fromJust ) import qualified Data.Set as S -import Data.Typeable ( Typeable ) import Data.Word ( Word64 ) import System.FilePath ( dropExtension, replaceExtension ) import qualified Test.Tasty as T @@ -26,7 +23,6 @@ import qualified Data.ElfEdit as E import qualified Data.Parameterized.Some as PU import qualified Data.Macaw.Memory as MM -import qualified Data.Macaw.Memory.ElfLoader as MM import qualified Data.Macaw.Discovery as MD import qualified Data.Macaw.Discovery.State as MD import qualified Data.Macaw.PPC as RO @@ -34,6 +30,8 @@ import qualified Data.Macaw.PPC as RO import Data.List (intercalate) import Debug.Trace (trace) +import Shared + ppcAsmTests :: [FilePath] -> T.TestTree ppcAsmTests = T.testGroup "PPC" . map mkTest @@ -70,16 +68,6 @@ mkTest fp = T.testCase fp $ withELF exeFilename (testDiscovery fp) showSegments :: (MM.MemWidth w) => MM.Memory w -> String showSegments mem = intercalate "\n" $ map show (MM.memSegments mem) --- | Given an Elf object and the corresponding Memory object, find the address of the --- correct entry point to the program -findEntryPoint64 :: E.Elf 64 -> MM.Memory 64 -> MM.MemAddr 64 -findEntryPoint64 elf mem = case E.elfMachine elf of - E.EM_PPC64 -> - let startEntry = E.elfEntry elf - Right addr = MM.readAddr mem MM.BigEndian (MM.absoluteAddr (MM.memWord (fromIntegral (startEntry)))) - in trace ("addr = " ++ show addr) addr - _ -> MM.absoluteAddr (MM.memWord (fromIntegral (E.elfEntry elf))) - -- | Run a test over a given expected result filename and the ELF file -- associated with it testDiscovery :: FilePath -> E.Elf 64 -> IO () @@ -130,30 +118,3 @@ removeIgnored actualBlockStarts ignoredBlocks = then S.delete v acc else acc) actualBlockStarts actualBlockStarts -withELF :: FilePath -> (E.Elf 64 -> IO ()) -> IO () -withELF fp k = do - bytes <- B.readFile fp - case E.parseElf bytes of - E.ElfHeaderError off msg -> - error ("Error parsing ELF header at offset " ++ show off ++ ": " ++ msg) - E.Elf32Res [] _e32 -> error "ELF32 is unsupported in the test suite" - E.Elf64Res [] e64 -> k e64 - E.Elf32Res errs _ -> error ("Errors while parsing ELF file: " ++ show errs) - E.Elf64Res errs _ -> error ("Errors while parsing ELF file: " ++ show errs) - -withMemory :: forall w m a - . (C.MonadThrow m, MM.MemWidth w, Integral (E.ElfWordType w)) - => MM.AddrWidthRepr w - -> E.Elf w - -> (MM.Memory w -> m a) - -> m a -withMemory _ e k = - case MM.memoryForElf (MM.LoadOptions MM.LoadBySegment False) e of - -- case MM.memoryForElfSegments relaWidth e of - Left err -> C.throwM (MemoryLoadError err) - Right (_sim, mem) -> k mem - -data ElfException = MemoryLoadError String - deriving (Typeable, Show) - -instance C.Exception ElfException diff --git a/macaw-ppc/tests/Shared.hs b/macaw-ppc/tests/Shared.hs new file mode 100644 index 00000000..3b08437f --- /dev/null +++ b/macaw-ppc/tests/Shared.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +module Shared ( + withELF, + withMemory, + findEntryPoint64 + ) where + +import qualified Control.Monad.Catch as C +import qualified Data.ByteString as B +import Data.Typeable ( Typeable ) + +import qualified Data.ElfEdit as E + +import qualified Data.Macaw.Memory as MM +import qualified Data.Macaw.Memory.ElfLoader as MM + +-- | Given an Elf object and the corresponding Memory object, find the address of the +-- correct entry point to the program +findEntryPoint64 :: E.Elf 64 -> MM.Memory 64 -> MM.MemAddr 64 +findEntryPoint64 elf mem = case E.elfMachine elf of + E.EM_PPC64 -> + let startEntry = E.elfEntry elf + Right addr = MM.readAddr mem MM.BigEndian (MM.absoluteAddr (MM.memWord (fromIntegral (startEntry)))) + in addr + _ -> MM.absoluteAddr (MM.memWord (fromIntegral (E.elfEntry elf))) + +withELF :: FilePath -> (E.Elf 64 -> IO ()) -> IO () +withELF fp k = do + bytes <- B.readFile fp + case E.parseElf bytes of + E.ElfHeaderError off msg -> + error ("Error parsing ELF header at offset " ++ show off ++ ": " ++ msg) + E.Elf32Res [] _e32 -> error "ELF32 is unsupported in the test suite" + E.Elf64Res [] e64 -> k e64 + E.Elf32Res errs _ -> error ("Errors while parsing ELF file: " ++ show errs) + E.Elf64Res errs _ -> error ("Errors while parsing ELF file: " ++ show errs) + +withMemory :: forall w m a + . (C.MonadThrow m, MM.MemWidth w, Integral (E.ElfWordType w)) + => MM.AddrWidthRepr w + -> E.Elf w + -> (MM.Memory w -> m a) + -> m a +withMemory _ e k = + case MM.memoryForElf (MM.LoadOptions MM.LoadBySegment False) e of + -- case MM.memoryForElfSegments relaWidth e of + Left err -> C.throwM (MemoryLoadError err) + Right (_sim, mem) -> k mem + +data ElfException = MemoryLoadError String + deriving (Typeable, Show) + +instance C.Exception ElfException