mirror of
https://github.com/GaloisInc/macaw.git
synced 2024-12-26 07:33:33 +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
|
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,
|
||||||
|
@ -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
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