mirror of
https://github.com/GaloisInc/macaw.git
synced 2024-12-25 07:02:59 +03:00
Split some shared helpers out of a test module
This commit is contained in:
parent
1f9ba647cf
commit
d5d1d87fd5
@ -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,
|
||||
|
@ -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
|
||||
|
55
macaw-ppc/tests/Shared.hs
Normal file
55
macaw-ppc/tests/Shared.hs
Normal 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
|
Loading…
Reference in New Issue
Block a user