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-ppc
, macaw-refinement
, macaw-symbolic
, macaw-x86
, macaw-x86-symbolic
, optparse-applicative >= 0.13 && < 0.15
, parameterized-utils
, QuickCheck >= 2.7

View File

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

View File

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