llvm-general 3.2.6.0 → 3.2.6.1
raw patch · 5 files changed
+156/−5 lines, 5 files
Files
- llvm-general.cabal +4/−3
- src/LLVM/General/PrettyPrint.hs +2/−0
- test/LLVM/General/Test/Instrumentation.hs +139/−0
- test/LLVM/General/Test/PrettyPrint.hs +2/−1
- test/LLVM/General/Test/Support.hs +9/−1
llvm-general.cabal view
@@ -1,5 +1,5 @@ name: llvm-general-version: 3.2.6.0+version: 3.2.6.1 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet <fgthb0@greynode.net>@@ -16,7 +16,7 @@ handles almost all of the stateful complexities of using the LLVM API to build IR; and it supports moving IR not only from Haskell into LLVM C++ objects, but the other direction - from LLVM C++ into Haskell. .- For haddock, see <http://bscarlet.github.io/llvm-general/3.2.6.0/doc/html/llvm-general/index.html>.+ For haddock, see <http://bscarlet.github.io/llvm-general/3.2.6.1/doc/html/llvm-general/index.html>. extra-source-files: src/LLVM/General/Internal/FFI/Analysis.h src/LLVM/General/Internal/FFI/Function.h@@ -37,7 +37,7 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.2- tag: v3.2.6.0+ tag: v3.2.6.1 flag shared-llvm description: link against llvm shared rather than static library@@ -221,6 +221,7 @@ LLVM.General.Test.Global LLVM.General.Test.InlineAssembly LLVM.General.Test.Instructions+ LLVM.General.Test.Instrumentation LLVM.General.Test.Linking LLVM.General.Test.Metadata LLVM.General.Test.Module
src/LLVM/General/PrettyPrint.hs view
@@ -4,6 +4,7 @@ #-} -- | Tools for printing out AST.'LLVM.General.AST.Module' code so that it's actually useful. module LLVM.General.PrettyPrint (+ PrettyShow(..), showPretty, showPrettyEx, PrefixScheme(..),@@ -102,6 +103,7 @@ basePrefixScheme :: PrefixScheme basePrefixScheme = PrefixScheme $ Map.fromList [ ("Data.Maybe", Nothing),+ ("Data.Either", Nothing), ("Data.Map", Just "Map"), ("Data.Set", Just "Set") ]
+ test/LLVM/General/Test/Instrumentation.hs view
@@ -0,0 +1,139 @@+module LLVM.General.Test.Instrumentation where++import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit++import LLVM.General.Test.Support++import Control.Monad.Error+import Data.Functor+import qualified Data.List as List+import qualified Data.Set as Set+import qualified Data.Map as Map++import LLVM.General.Module+import LLVM.General.Context+import LLVM.General.PassManager+import LLVM.General.Transforms+import LLVM.General.Target++import LLVM.General.AST as A+import LLVM.General.AST.Type+import LLVM.General.AST.Name+import LLVM.General.AST.AddrSpace+import LLVM.General.AST.DataLayout+import qualified LLVM.General.AST.IntegerPredicate as IPred+import qualified LLVM.General.AST.Linkage as L+import qualified LLVM.General.AST.Visibility as V+import qualified LLVM.General.AST.CallingConvention as CC+import qualified LLVM.General.AST.Attribute as A+import qualified LLVM.General.AST.Global as G+import qualified LLVM.General.AST.Constant as C++instrument :: PassSetSpec -> A.Module -> IO A.Module+instrument s m = withContext $ \context -> withModuleFromAST' context m $ \mIn' -> do+ withPassManager s $ \pm -> runPassManager pm mIn'+ moduleAST mIn'++ast = do+ dl <- withDefaultTargetMachine getTargetMachineDataLayout+ return $ Module "<string>" (Just dl) Nothing [+ GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "foo") ([+ Parameter (IntegerType 128) (Name "x") []+ ],False)+ [] + Nothing 0 + [+ BasicBlock (UnName 0) [] (Do $ Br (Name "checkDone") []),+ BasicBlock (Name "checkDone") [+ UnName 1 := Phi {+ type' = IntegerType 128,+ incomingValues = [+ (LocalReference (Name "x"), UnName 0),+ (LocalReference (Name "x'"), Name "even"),+ (LocalReference (Name "x''"), Name "odd")+ ],+ metadata = []+ },+ Name "count" := Phi {+ type' = IntegerType 32,+ incomingValues = [+ (ConstantOperand (C.Int 32 1), UnName 0),+ (LocalReference (Name "count'"), Name "even"),+ (LocalReference (Name "count'"), Name "odd")+ ],+ metadata = []+ },+ Name "count'" := Add False False (LocalReference (Name "count")) (ConstantOperand (C.Int 32 1)) [],+ Name "is one" := ICmp IPred.EQ (LocalReference (UnName 1)) (ConstantOperand (C.Int 128 1)) []+ ] (+ Do $ CondBr (LocalReference (Name "is one")) (Name "done") (Name "checkOdd") []+ ),+ BasicBlock (Name "checkOdd") [+ Name "is odd" := Trunc (LocalReference (UnName 1)) (IntegerType 1) []+ ] (+ Do $ CondBr (LocalReference (Name "is odd")) (Name "odd") (Name "even") []+ ),+ BasicBlock (Name "even") [+ Name "x'" := UDiv True (LocalReference (UnName 1)) (ConstantOperand (C.Int 128 2)) []+ ] (+ Do $ Br (Name "checkDone") []+ ),+ BasicBlock (Name "odd") [+ UnName 2 := Mul False False (LocalReference (UnName 1)) (ConstantOperand (C.Int 128 3)) [],+ Name "x''" := Add False False (LocalReference (UnName 2)) (ConstantOperand (C.Int 128 1)) []+ ] (+ Do $ Br (Name "checkDone") []+ ),+ BasicBlock (Name "done") [+ ] (+ Do $ Ret (Just (LocalReference (Name "count'"))) []+ )+ ],+ GlobalDefinition $ Function L.External V.Default CC.C [] (IntegerType 32) (Name "main") ([+ Parameter (IntegerType 32) (Name "argc") [],+ Parameter (PointerType (PointerType (IntegerType 8) (AddrSpace 0)) (AddrSpace 0)) (Name "argv") []+ ],False)+ [] + Nothing 0 + [+ BasicBlock (UnName 0) [+ UnName 1 := Call {+ isTailCall = False,+ callingConvention = CC.C,+ returnAttributes = [],+ function = Right (ConstantOperand (C.GlobalReference (Name "foo"))),+ arguments = [+ (ConstantOperand (C.Int 128 9491828328), [])+ ],+ functionAttributes = [],+ metadata = []+ }+ ] (+ Do $ Ret (Just (LocalReference (UnName 1))) []+ )+ ]+ ]++tests = testGroup "Instrumentation" [+ testGroup "basic" [+ testCase n $ do+ triple <- getDefaultTargetTriple+ withTargetLibraryInfo triple $ \tli -> do+ Right dl <- runErrorT $ withDefaultTargetMachine getTargetMachineDataLayout+ Right ast <- runErrorT ast+ ast' <- instrument (defaultPassSetSpec { transforms = [p], dataLayout = Just dl, targetLibraryInfo = Just tli }) ast+ let names ast = [ n | GlobalDefinition d <- moduleDefinitions ast, Name n <- return (G.name d) ]+ (names ast') `List.intersect` (names ast) @?= names ast+ | (n,p) <- [+ ("EdgeProfiler", EdgeProfiler),+ ("OptimalEdgeProfiler", OptimalEdgeProfiler),+ ("PathProfiler", PathProfiler),+ ("GCOVProfiler", defaultGCOVProfiler),+ ("AddressSanitizer", defaultAddressSanitizer),+ ("ThreadSanitizer", defaultThreadSanitizer),+ ("BoundsChecking", BoundsChecking)+ ]+ ]+ ]
test/LLVM/General/Test/PrettyPrint.hs view
@@ -75,7 +75,8 @@ showPretty ast @?= s, testCase "imports" $ do imports defaultPrefixScheme @?= - "import qualified Data.Map as Map\n\+ "import Data.Either\n\+ \import qualified Data.Map as Map\n\ \import Data.Maybe\n\ \import qualified Data.Set as Set\n\ \import qualified LLVM.General.AST as A\n\
test/LLVM/General/Test/Support.hs view
@@ -11,6 +11,7 @@ import LLVM.General.Context import LLVM.General.Module import LLVM.General.Diagnostic+import LLVM.General.PrettyPrint class FailInIO f where errorToString :: f -> String@@ -27,10 +28,17 @@ withModuleFromString' c s f = failInIO $ withModuleFromString c s f withModuleFromAST' c a f = failInIO $ withModuleFromAST c a f +assertEqPretty :: (Eq a, PrettyShow a) => a -> a -> Assertion+assertEqPretty actual expected = do+ let showPretty = showPrettyEx 80 " " shortPrefixScheme+ assertBool + ("expected: " ++ showPretty expected ++ "\n" ++ "but got: " ++ showPretty actual ++ "\n")+ (expected == actual)+ strCheckC mAST mStr mStrCanon = withContext $ \context -> do a <- withModuleFromString' context mStr moduleAST s <- withModuleFromAST' context mAST moduleString- (a,s) @?= (mAST, mStrCanon)+ (a,s) `assertEqPretty` (mAST, mStrCanon) strCheck mAST mStr = strCheckC mAST mStr mStr