Split some shared helpers out of a test module

This commit is contained in:
Tristan Ravitch 2017-11-09 10:43:41 -08:00
parent 1f9ba647cf
commit d5d1d87fd5
3 changed files with 58 additions and 41 deletions

View File

@ -57,6 +57,7 @@ test-suite macaw-ppc-tests
ghc-options: -Wall ghc-options: -Wall
main-is: Main.hs main-is: Main.hs
other-modules: PPC64Tests other-modules: PPC64Tests
Shared
hs-source-dirs: tests hs-source-dirs: tests
build-depends: base >=4.9 && <5, build-depends: base >=4.9 && <5,
bytestring, bytestring,

View File

@ -8,13 +8,10 @@ module PPC64Tests (
) where ) where
import Control.Lens ( (^.) ) 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.Foldable as F
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe ( fromJust ) import Data.Maybe ( fromJust )
import qualified Data.Set as S import qualified Data.Set as S
import Data.Typeable ( Typeable )
import Data.Word ( Word64 ) import Data.Word ( Word64 )
import System.FilePath ( dropExtension, replaceExtension ) import System.FilePath ( dropExtension, replaceExtension )
import qualified Test.Tasty as T 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.Parameterized.Some as PU
import qualified Data.Macaw.Memory as MM 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 as MD
import qualified Data.Macaw.Discovery.State as MD import qualified Data.Macaw.Discovery.State as MD
import qualified Data.Macaw.PPC as RO import qualified Data.Macaw.PPC as RO
@ -34,6 +30,8 @@ import qualified Data.Macaw.PPC as RO
import Data.List (intercalate) import Data.List (intercalate)
import Debug.Trace (trace) import Debug.Trace (trace)
import Shared
ppcAsmTests :: [FilePath] -> T.TestTree ppcAsmTests :: [FilePath] -> T.TestTree
ppcAsmTests = T.testGroup "PPC" . map mkTest 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 :: (MM.MemWidth w) => MM.Memory w -> String
showSegments mem = intercalate "\n" $ map show (MM.memSegments mem) 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 -- | Run a test over a given expected result filename and the ELF file
-- associated with it -- associated with it
testDiscovery :: FilePath -> E.Elf 64 -> IO () testDiscovery :: FilePath -> E.Elf 64 -> IO ()
@ -130,30 +118,3 @@ removeIgnored actualBlockStarts ignoredBlocks =
then S.delete v acc then S.delete v acc
else acc) actualBlockStarts actualBlockStarts 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

55
macaw-ppc/tests/Shared.hs Normal file
View File

@ -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