mirror of
https://github.com/GaloisInc/macaw.git
synced 2024-12-18 19:41:44 +03:00
53 lines
1.8 KiB
Haskell
53 lines
1.8 KiB
Haskell
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
module PPC64InstructionCoverage (
|
|
ppc64InstructionCoverageTests
|
|
) where
|
|
|
|
import Control.Lens ( (^.) )
|
|
import qualified Data.Foldable as F
|
|
import qualified Data.Map as M
|
|
import Data.Maybe ( fromJust )
|
|
import qualified Data.Set as S
|
|
import Data.Word ( Word64 )
|
|
import qualified Test.Tasty as T
|
|
import qualified Test.Tasty.HUnit as T
|
|
|
|
import qualified Data.ElfEdit as E
|
|
|
|
import qualified Data.Parameterized.Some as PU
|
|
import qualified Data.Macaw.BinaryLoader as MBL
|
|
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.PPC as RO
|
|
import qualified SemMC.Architecture.PPC64 as PPC64
|
|
|
|
import Shared
|
|
|
|
ppc64InstructionCoverageTests :: [FilePath] -> T.TestTree
|
|
ppc64InstructionCoverageTests = T.testGroup "PPCCoverage" . map mkTest
|
|
|
|
mkTest :: FilePath -> T.TestTree
|
|
mkTest fp = T.testCase fp (withELF fp testMacaw)
|
|
|
|
testMacaw :: E.Elf 64 -> IO ()
|
|
testMacaw elf = do
|
|
let loadCfg = MM.defaultLoadOptions { MM.loadRegionIndex = Just 0 }
|
|
loadedBinary :: MBL.LoadedBinary PPC64.PPC (E.Elf 64)
|
|
<- MBL.loadBinary loadCfg elf
|
|
entries <- MBL.entryPoints loadedBinary
|
|
let cfg = RO.ppc64_linux_info (MBL.archBinaryData loadedBinary)
|
|
let mem = MBL.memoryImage loadedBinary
|
|
let di = MD.cfgFromAddrs cfg mem M.empty (F.toList entries) []
|
|
let allFoundBlockAddrs :: S.Set Word64
|
|
allFoundBlockAddrs =
|
|
S.fromList [ fromIntegral (fromJust (MM.asAbsoluteAddr (MM.relativeSegmentAddr (MD.pblockAddr pbr))))
|
|
| PU.Some dfi <- M.elems (di ^. MD.funInfo)
|
|
, pbr <- M.elems (dfi ^. MD.parsedBlocks)
|
|
]
|
|
T.assertBool "No blocks found" (not (S.null allFoundBlockAddrs))
|
|
|
|
|