This commit is contained in:
Andrei Stefanescu 2019-01-29 16:29:54 -08:00
parent 8bd3ea41d1
commit 2efd7bc0e6
3 changed files with 13 additions and 3 deletions

View File

@ -120,7 +120,9 @@ test-suite test-refinements
, macaw-loader-ppc , macaw-loader-ppc
, macaw-ppc , macaw-ppc
, macaw-refinement , macaw-refinement
, macaw-symbolic
, macaw-x86 , macaw-x86
, macaw-x86-symbolic
, optparse-applicative >= 0.13 && < 0.15 , optparse-applicative >= 0.13 && < 0.15
, parameterized-utils , parameterized-utils
, QuickCheck >= 2.7 , QuickCheck >= 2.7

View File

@ -83,7 +83,7 @@ bldFPath fi (fs, b:bs) =
updPath = if null nextBlkAddrs updPath = if null nextBlkAddrs
then if isTopLevelPathEntry then if isTopLevelPathEntry
then fs then fs
else b $ Path b [] [] : fs else Path b [] [] : fs
else foldr (bldFPath' fi b) fs nextBlkAddrs else foldr (bldFPath' fi b) fs nextBlkAddrs
in bldFPath fi (updPath, bs) in bldFPath fi (updPath, bs)

View File

@ -22,13 +22,17 @@
-- source is described, along with various tests. -- source is described, along with various tests.
{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# OPTIONS_GHC -Wno-missing-signatures #-}
module Main ( main ) where module Main ( main ) where
import GHC.TypeLits
import Control.Lens hiding ( (<.>) ) import Control.Lens hiding ( (<.>) )
import Control.Monad import Control.Monad
import qualified Control.Monad.Catch as X import qualified Control.Monad.Catch as X
@ -46,7 +50,9 @@ import qualified Data.Macaw.Discovery as MD
import qualified Data.Macaw.Memory.ElfLoader as ML import qualified Data.Macaw.Memory.ElfLoader as ML
import Data.Macaw.PPC import Data.Macaw.PPC
import Data.Macaw.Refinement import Data.Macaw.Refinement
import qualified Data.Macaw.Symbolic as MS
import qualified Data.Macaw.X86 as MX86 import qualified Data.Macaw.X86 as MX86
import Data.Macaw.X86.Symbolic()
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe ( catMaybes ) import Data.Maybe ( catMaybes )
import Data.Parameterized.Some import Data.Parameterized.Some
@ -234,6 +240,8 @@ testExpected useRefinement expFile testinp beVerbose readBinary = do
m -> error $ "no 32-bit ELF support for " ++ show m m -> error $ "no 32-bit ELF support for " ++ show m
withBinaryDiscoveredInfo :: ( X.MonadThrow m withBinaryDiscoveredInfo :: ( X.MonadThrow m
, MS.SymArchConstraints arch
, 16 <= MC.ArchAddrWidth arch
, MBL.BinaryLoader arch binFmt , MBL.BinaryLoader arch binFmt
, MonadIO m) => , MonadIO m) =>
TestInput TestInput
@ -246,8 +254,8 @@ withBinaryDiscoveredInfo testinp useRefinement expFile arch_info bin = do
entries <- toList <$> entryPoints bin entries <- toList <$> entryPoints bin
let baseCFG = MD.cfgFromAddrs arch_info (memoryImage bin) M.empty entries [] let baseCFG = MD.cfgFromAddrs arch_info (memoryImage bin) M.empty entries []
actualBase = cfgToExpected testinp bin (Just baseCFG) Nothing actualBase = cfgToExpected testinp bin (Just baseCFG) Nothing
refinedCFG = refineDiscovery baseCFG refinedCFG <- refineDiscovery baseCFG
refinedBase = cfgToExpected testinp bin Nothing (Just refinedCFG) let refinedBase = cfgToExpected testinp bin Nothing (Just refinedCFG)
formName = if useRefinement then "refined" else "base" formName = if useRefinement then "refined" else "base"
actual = if useRefinement then refinedBase else actualBase actual = if useRefinement then refinedBase else actualBase
compareToExpected formName actual expFile compareToExpected formName actual expFile