diff --git a/llvm-general.cabal b/llvm-general.cabal --- a/llvm-general.cabal +++ b/llvm-general.cabal @@ -1,5 +1,5 @@ name: llvm-general -version: 3.2.4.1 +version: 3.2.4.2 license: BSD3 license-file: LICENSE author: Benjamin S.Scarlet @@ -16,14 +16,15 @@ 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. extra-source-files: + src/LLVM/General/Internal/FFI/Analysis.h + src/LLVM/General/Internal/FFI/Function.h + src/LLVM/General/Internal/FFI/GlobalValue.h + src/LLVM/General/Internal/FFI/InlineAssembly.h src/LLVM/General/Internal/FFI/Instruction.h - src/LLVM/General/Internal/FFI/Value.h src/LLVM/General/Internal/FFI/SMDiagnostic.h - src/LLVM/General/Internal/FFI/InlineAssembly.h src/LLVM/General/Internal/FFI/Target.h - src/LLVM/General/Internal/FFI/Function.h - src/LLVM/General/Internal/FFI/GlobalValue.h src/LLVM/General/Internal/FFI/Type.h + src/LLVM/General/Internal/FFI/Value.h source-repository head type: git @@ -33,7 +34,7 @@ type: git location: git://github.com/bscarlet/llvm-general.git branch: llvm-3.2 - tag: v3.2.4.1 + tag: v3.2.4.2 flag shared-llvm description: link against llvm shared rather than static library @@ -86,6 +87,7 @@ LLVM.General.AST.RMWOperation LLVM.General.AST.Type LLVM.General.AST.Visibility + LLVM.General.Analysis LLVM.General.CodeGenOpt LLVM.General.CodeModel LLVM.General.CommandLine @@ -103,6 +105,7 @@ Control.Monad.AnyCont Control.Monad.AnyCont.Class Control.Monad.Trans.AnyCont + LLVM.General.Internal.Analysis LLVM.General.Internal.Atomicity LLVM.General.Internal.Attribute LLVM.General.Internal.BasicBlock @@ -132,6 +135,7 @@ LLVM.General.Internal.Target LLVM.General.Internal.Type LLVM.General.Internal.Value + LLVM.General.Internal.FFI.Analysis LLVM.General.Internal.FFI.Assembly LLVM.General.Internal.FFI.BasicBlock LLVM.General.Internal.FFI.BinaryOperator @@ -202,6 +206,7 @@ FlexibleContexts main-is: Test.hs other-modules: + LLVM.General.Test.Analysis LLVM.General.Test.Constants LLVM.General.Test.DataLayout LLVM.General.Test.ExecutionEngine diff --git a/src/LLVM/General/Analysis.hs b/src/LLVM/General/Analysis.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/General/Analysis.hs @@ -0,0 +1,8 @@ +-- | functionality for analyzing 'LLVM.General.Module.Module's. Much of the analysis +-- possible with LLVM is managed internally, as needed by 'Transforms', and so is not +-- yet exposed here. +module LLVM.General.Analysis ( + verify + ) where + +import LLVM.General.Internal.Analysis diff --git a/src/LLVM/General/Internal/Analysis.hs b/src/LLVM/General/Internal/Analysis.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/General/Internal/Analysis.hs @@ -0,0 +1,19 @@ +module LLVM.General.Internal.Analysis where + +import Control.Monad.Error +import Control.Monad.AnyCont + +import qualified LLVM.General.Internal.FFI.Analysis as FFI +import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI + +import LLVM.General.Internal.Module +import LLVM.General.Internal.Coding + +-- | Run basic sanity checks on a 'Module'. Note that the same checks will trigger assertions +-- within LLVM if LLVM was built with them turned on, before this function can be is called. +verify :: Module -> ErrorT String IO () +verify (Module m) = flip runAnyContT return $ do + errorPtr <- alloca + result <- decodeM =<< (liftIO $ FFI.verifyModule m FFI.verifierFailureActionReturnStatus errorPtr) + when result $ fail =<< decodeM errorPtr + diff --git a/src/LLVM/General/Internal/EncodeAST.hs b/src/LLVM/General/Internal/EncodeAST.hs --- a/src/LLVM/General/Internal/EncodeAST.hs +++ b/src/LLVM/General/Internal/EncodeAST.hs @@ -18,7 +18,6 @@ import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.General.Internal.FFI.Builder as FFI -import qualified LLVM.General.Internal.FFI.Type as FFI import qualified LLVM.General.AST as A diff --git a/src/LLVM/General/Internal/FFI/Analysis.h b/src/LLVM/General/Internal/FFI/Analysis.h new file mode 100644 --- /dev/null +++ b/src/LLVM/General/Internal/FFI/Analysis.h @@ -0,0 +1,11 @@ +#ifndef __LLVM_GENERAL_INTERNAL_FFI__ANALYSIS__H__ +#define __LLVM_GENERAL_INTERNAL_FFI__ANALYSIS__H__ + +#include "llvm-c/Analysis.h" + +#define LLVM_GENERAL_FOR_EACH_VERIFIER_FAILURE_ACTION(macro) \ + macro(AbortProcess) \ + macro(PrintMessage) \ + macro(ReturnStatus) + +#endif diff --git a/src/LLVM/General/Internal/FFI/Analysis.hs b/src/LLVM/General/Internal/FFI/Analysis.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/General/Internal/FFI/Analysis.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE + ForeignFunctionInterface + #-} +module LLVM.General.Internal.FFI.Analysis where + +import Foreign.Ptr +import Foreign.C + +import LLVM.General.Internal.FFI.LLVMCTypes +import LLVM.General.Internal.FFI.Module + +foreign import ccall unsafe "LLVMVerifyModule" verifyModule :: + Ptr Module -> VerifierFailureAction -> Ptr MallocedCString -> IO LLVMBool diff --git a/src/LLVM/General/Internal/FFI/BinaryOperator.hs b/src/LLVM/General/Internal/FFI/BinaryOperator.hs --- a/src/LLVM/General/Internal/FFI/BinaryOperator.hs +++ b/src/LLVM/General/Internal/FFI/BinaryOperator.hs @@ -13,11 +13,6 @@ import LLVM.General.Internal.FFI.PtrHierarchy import LLVM.General.Internal.FFI.LLVMCTypes --- | a blind type to correspond to llvm::BinaryOperator -data BinaryOperator - -instance ChildOf Instruction BinaryOperator - foreign import ccall unsafe "LLVMIsABinaryOperator" isABinaryOperator :: Ptr Value -> IO (Ptr BinaryOperator) diff --git a/src/LLVM/General/Internal/FFI/Builder.hs b/src/LLVM/General/Internal/FFI/Builder.hs --- a/src/LLVM/General/Internal/FFI/Builder.hs +++ b/src/LLVM/General/Internal/FFI/Builder.hs @@ -1,16 +1,17 @@ {-# LANGUAGE ForeignFunctionInterface, - TemplateHaskell + TemplateHaskell, + ViewPatterns #-} -- | FFI glue for llvm::IRBuilder - llvm's IR construction state object module LLVM.General.Internal.FFI.Builder where import qualified Language.Haskell.TH as TH +import Control.Monad + import qualified LLVM.General.AST.Instruction as A -import qualified LLVM.General.AST.Operand as A -import qualified LLVM.General.AST.Type as A import LLVM.General.Internal.InstructionDefs as ID @@ -19,10 +20,9 @@ import qualified Data.Map as Map -import LLVM.General.Internal.FFI.LLVMCTypes +import LLVM.General.Internal.FFI.Cleanup import LLVM.General.Internal.FFI.Context -import LLVM.General.Internal.FFI.BinaryOperator -import LLVM.General.Internal.FFI.Type +import LLVM.General.Internal.FFI.LLVMCTypes import LLVM.General.Internal.FFI.PtrHierarchy data Builder @@ -64,29 +64,23 @@ $(do - sequence [ - TH.forImpD TH.cCall TH.unsafe cName (TH.mkName ("build" ++ a)) [t| - Ptr Builder -> $(foldr (\at rt -> [t| $(at) -> $(rt) |]) [t| CString -> IO (Ptr $(rt)) |] ats) - |] - | (lrn, ID.InstructionDef { ID.cAPIName = a, ID.instructionKind = k }) <- Map.toList ID.instructionDefs, - let fieldTypes = - (\(TH.RecC _ fs) -> [ t | (_,_,t) <- fs]) $ - Map.findWithDefault - (error $ "LLVM instruction not found in AST: " ++ show lrn) - lrn ID.astInstructionRecs - ats = flip concatMap fieldTypes $ \ft -> - case ft of - TH.ConT h | h == ''Bool -> [[t| LLVMBool |]] - | h == ''A.Operand -> [[t| Ptr Value |]] - | h == ''A.Type -> [[t| Ptr Type |]] - | h == ''A.InstructionMetadata -> [] - _ -> error $ "show ft = " ++ show ft - cName = (if TH.ConT ''Bool `elem` fieldTypes then "LLVM_General_" else "LLVM") ++ "Build" ++ a, - rt <- case k of - ID.Binary -> [[t| BinaryOperator |]] - ID.Cast -> [[t| Instruction |]] - _ -> [] - ] + liftM concat $ sequence $ do + let instrInfo = ID.outerJoin ID.astInstructionRecs ID.instructionDefs + (lrn, ii) <- Map.toList instrInfo + (TH.RecC _ (unzip3 -> (_, _, fieldTypes)), ID.InstructionDef { ID.cAPIName = a, ID.instructionKind = k }) <- case ii of + (Just r, Just d) -> return (r,d) + (Just _, Nothing) -> error $ "An AST instruction was not found in the LLVM instruction defs" + (Nothing, Just ID.InstructionDef { ID.instructionKind = k }) | k /= ID.Terminator -> + error $ "LLVM instruction def " ++ lrn ++ " not found in the AST" + _ -> [] + + let ats = map typeMapping [ t | t <- fieldTypes, t /= TH.ConT ''A.InstructionMetadata ] + cName = (if hasFlags fieldTypes then "LLVM_General_" else "LLVM") ++ "Build" ++ a + rt <- case k of + ID.Binary -> [[t| BinaryOperator |]] + ID.Cast -> [[t| Instruction |]] + _ -> [] + return $ foreignDecl cName ("build" ++ a) ([[t| Ptr Builder |]] ++ ats ++ [[t| CString |]]) [t| Ptr $(rt) |] ) foreign import ccall unsafe "LLVMBuildArrayAlloca" buildAlloca :: diff --git a/src/LLVM/General/Internal/FFI/Cleanup.hs b/src/LLVM/General/Internal/FFI/Cleanup.hs --- a/src/LLVM/General/Internal/FFI/Cleanup.hs +++ b/src/LLVM/General/Internal/FFI/Cleanup.hs @@ -8,16 +8,19 @@ import Data.Sequence as Seq import Data.Foldable (toList) -import Data.Function - -import LLVM.General.Internal.FFI.LLVMCTypes import Data.Word import Data.Int import Foreign.C import Foreign.Ptr +import LLVM.General.Internal.FFI.LLVMCTypes +import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI + import qualified LLVM.General.AST.IntegerPredicate as A (IntegerPredicate) import qualified LLVM.General.AST.FloatingPointPredicate as A (FloatingPointPredicate) +import qualified LLVM.General.AST.Constant as A.C (Constant) +import qualified LLVM.General.AST.Operand as A (Operand) +import qualified LLVM.General.AST.Type as A (Type) foreignDecl :: String -> String -> [TypeQ] -> TypeQ -> DecsQ foreignDecl cName hName argTypeQs returnTypeQ = do @@ -59,15 +62,22 @@ ] ] -typeMappingU :: (Type -> TypeQ) -> Type -> TypeQ -typeMappingU typeMapping t = case t of +-- | The LLVM C-API for instructions with boolean flags (e.g. nsw) is weak, so they get +-- separated out for different handling. This check is an accurate but crude test for whether +-- an instruction needs such handling. As such it may need revision in the future (if has-a-boolean-member +-- is no longer the same as needs-special-handling). +hasFlags :: [Type] -> Bool +hasFlags = any (== ConT ''Bool) + +typeMapping :: Type -> TypeQ +typeMapping t = case t of ConT h | h == ''Bool -> [t| LLVMBool |] | h == ''Int32 -> [t| CInt |] | h == ''Word32 -> [t| CUInt |] | h == ''String -> [t| CString |] + | h == ''A.Operand -> [t| Ptr FFI.Value |] + | h == ''A.Type -> [t| Ptr FFI.Type |] + | h == ''A.C.Constant -> [t| Ptr FFI.Constant |] | h == ''A.FloatingPointPredicate -> [t| FCmpPredicate |] | h == ''A.IntegerPredicate -> [t| ICmpPredicate |] AppT ListT x -> foldl1 appT [tupleT 2, [t| CUInt |], appT [t| Ptr |] (typeMapping x)] - -typeMapping :: Type -> TypeQ -typeMapping = fix typeMappingU diff --git a/src/LLVM/General/Internal/FFI/Constant.hs b/src/LLVM/General/Internal/FFI/Constant.hs --- a/src/LLVM/General/Internal/FFI/Constant.hs +++ b/src/LLVM/General/Internal/FFI/Constant.hs @@ -3,17 +3,16 @@ ForeignFunctionInterface, MultiParamTypeClasses, UndecidableInstances, - OverlappingInstances + OverlappingInstances, + ViewPatterns #-} -- | FFI functions for handling the LLVM Constant class module LLVM.General.Internal.FFI.Constant where import qualified Language.Haskell.TH as TH import qualified LLVM.General.Internal.InstructionDefs as ID -import qualified LLVM.General.AST.Constant as A.C import Control.Monad -import Data.Function import qualified Data.Map as Map import Data.Word @@ -23,7 +22,6 @@ import LLVM.General.Internal.FFI.PtrHierarchy import LLVM.General.Internal.FFI.Context import LLVM.General.Internal.FFI.Cleanup -import LLVM.General.Internal.FFI.Type import LLVM.General.Internal.FFI.LLVMCTypes foreign import ccall unsafe "LLVMIsConstant" isConstant :: @@ -90,18 +88,14 @@ $(do let constExprInfo = ID.innerJoin (ID.innerJoin ID.astConstantRecs ID.astInstructionRecs) ID.instructionDefs - let tm = fix tm' - where tm' _ (TH.ConT h) | h == ''A.C.Constant = [t| Ptr Constant |] - tm' x t = typeMappingU x t liftM concat $ sequence $ do - (name, ((TH.RecC _ fs,_), ID.InstructionDef { ID.instructionKind = ik })) <- Map.toList constExprInfo - let hasFlags = any (== ''Bool) [ h | (_, _, TH.ConT h) <- fs ] + (name, ((TH.RecC _ (unzip3 -> (_, _, fieldTypes)),_), ID.InstructionDef { ID.instructionKind = ik })) <- Map.toList constExprInfo prefix <- case ik of ID.Other -> return "LLVM" - ID.Binary | hasFlags -> return "LLVM_General_" + ID.Binary | hasFlags fieldTypes -> return "LLVM_General_" _ -> [] return $ - foreignDecl (prefix ++ "Const" ++ name) ("constant" ++ name) [tm t | (_, _, t) <- fs ] [t| Ptr Constant |] + foreignDecl (prefix ++ "Const" ++ name) ("constant" ++ name) (map typeMapping fieldTypes) [t| Ptr Constant |] ) foreign import ccall unsafe "LLVMConstGEP" constantGetElementPtr' :: diff --git a/src/LLVM/General/Internal/FFI/InlineAssembly.hs b/src/LLVM/General/Internal/FFI/InlineAssembly.hs --- a/src/LLVM/General/Internal/FFI/InlineAssembly.hs +++ b/src/LLVM/General/Internal/FFI/InlineAssembly.hs @@ -9,7 +9,6 @@ import LLVM.General.Internal.FFI.LLVMCTypes import LLVM.General.Internal.FFI.PtrHierarchy -import LLVM.General.Internal.FFI.Type foreign import ccall unsafe "LLVMIsAInlineAsm" isAInlineAsm :: Ptr Value -> IO (Ptr InlineAsm) diff --git a/src/LLVM/General/Internal/FFI/Instruction.hs b/src/LLVM/General/Internal/FFI/Instruction.hs --- a/src/LLVM/General/Internal/FFI/Instruction.hs +++ b/src/LLVM/General/Internal/FFI/Instruction.hs @@ -12,7 +12,6 @@ import Foreign.C import LLVM.General.Internal.FFI.PtrHierarchy -import LLVM.General.Internal.FFI.Type import LLVM.General.Internal.FFI.LLVMCTypes foreign import ccall unsafe "LLVMIsAInstruction" isAInstruction :: diff --git a/src/LLVM/General/Internal/FFI/LLVMCTypes.hsc b/src/LLVM/General/Internal/FFI/LLVMCTypes.hsc --- a/src/LLVM/General/Internal/FFI/LLVMCTypes.hsc +++ b/src/LLVM/General/Internal/FFI/LLVMCTypes.hsc @@ -17,6 +17,7 @@ #include "LLVM/General/Internal/FFI/Function.h" #include "LLVM/General/Internal/FFI/GlobalValue.h" #include "LLVM/General/Internal/FFI/Type.h" +#include "LLVM/General/Internal/FFI/Analysis.h" import Language.Haskell.TH.Quote @@ -184,3 +185,8 @@ deriving (Eq, Read, Show, Bits, Typeable, Data, Num) #define FA_Rec(n,a) { #n, LLVM ## n ## a }, #{inject FUNCTION_ATTR, FunctionAttr, FunctionAttr, functionAttr, FA_Rec} + +newtype VerifierFailureAction = VerifierFailureAction CUInt + deriving (Eq, Read, Show, Bits, Typeable, Data, Num) +#define VFA_Rec(n) { #n, LLVM ## n ## Action }, +#{inject VERIFIER_FAILURE_ACTION, VerifierFailureAction, VerifierFailureAction, verifierFailureAction, VFA_Rec} diff --git a/src/LLVM/General/Internal/FFI/Module.hs b/src/LLVM/General/Internal/FFI/Module.hs --- a/src/LLVM/General/Internal/FFI/Module.hs +++ b/src/LLVM/General/Internal/FFI/Module.hs @@ -9,7 +9,6 @@ import LLVM.General.Internal.FFI.Context import LLVM.General.Internal.FFI.LLVMCTypes import LLVM.General.Internal.FFI.PtrHierarchy -import LLVM.General.Internal.FFI.Type data Module diff --git a/src/LLVM/General/Internal/FFI/PassManager.hs b/src/LLVM/General/Internal/FFI/PassManager.hs --- a/src/LLVM/General/Internal/FFI/PassManager.hs +++ b/src/LLVM/General/Internal/FFI/PassManager.hs @@ -5,7 +5,7 @@ module LLVM.General.Internal.FFI.PassManager where -import Language.Haskell.TH +import qualified Language.Haskell.TH as TH import Control.Monad @@ -45,22 +45,22 @@ Ptr PassManager -> IO CUInt $(do - let declareForeign :: Name -> [Type] -> DecsQ + let declareForeign :: TH.Name -> [TH.Type] -> TH.DecsQ declareForeign hName extraParams = do - let n = nameBase hName + let n = TH.nameBase hName foreignDecl (cName n) ("add" ++ n ++ "Pass") ([[t| Ptr PassManager |]] ++ [[t| Ptr TargetLowering |] | needsTargetLowering n] ++ map typeMapping extraParams) - (tupleT 0) + (TH.tupleT 0) - TyConI (DataD _ _ _ cons _) <- reify ''G.Pass + TH.TyConI (TH.DataD _ _ _ cons _) <- TH.reify ''G.Pass liftM concat $ forM cons $ \con -> case con of - RecC n l -> declareForeign n [ t | (_,_,t) <- l ] - NormalC n [] -> declareForeign n [] - NormalC n _ -> error "pass descriptor constructors with fields need to be records" + TH.RecC n l -> declareForeign n [ t | (_,_,t) <- l ] + TH.NormalC n [] -> declareForeign n [] + TH.NormalC n _ -> error "pass descriptor constructors with fields need to be records" ) data PassManagerBuilder diff --git a/src/LLVM/General/Internal/FFI/PtrHierarchy.hs b/src/LLVM/General/Internal/FFI/PtrHierarchy.hs --- a/src/LLVM/General/Internal/FFI/PtrHierarchy.hs +++ b/src/LLVM/General/Internal/FFI/PtrHierarchy.hs @@ -68,6 +68,11 @@ instance ChildOf User Instruction +-- | +data BinaryOperator + +instance ChildOf Instruction BinaryOperator + -- | data User @@ -90,3 +95,7 @@ data InlineAsm instance ChildOf Value InlineAsm + +-- | +data Type + diff --git a/src/LLVM/General/Internal/FFI/Type.hs b/src/LLVM/General/Internal/FFI/Type.hs --- a/src/LLVM/General/Internal/FFI/Type.hs +++ b/src/LLVM/General/Internal/FFI/Type.hs @@ -10,9 +10,7 @@ import LLVM.General.Internal.FFI.LLVMCTypes import LLVM.General.Internal.FFI.Context - --- | a blind type to correspond to llvm::Type -data Type +import LLVM.General.Internal.FFI.PtrHierarchy -- | foreign import ccall unsafe "LLVMGetTypeKind" getTypeKind :: diff --git a/src/LLVM/General/Internal/FFI/Value.hs b/src/LLVM/General/Internal/FFI/Value.hs --- a/src/LLVM/General/Internal/FFI/Value.hs +++ b/src/LLVM/General/Internal/FFI/Value.hs @@ -11,7 +11,6 @@ import Foreign.C import LLVM.General.Internal.FFI.LLVMCTypes -import LLVM.General.Internal.FFI.Type import LLVM.General.Internal.FFI.PtrHierarchy -- | diff --git a/src/LLVM/General/Internal/Type.hs b/src/LLVM/General/Internal/Type.hs --- a/src/LLVM/General/Internal/Type.hs +++ b/src/LLVM/General/Internal/Type.hs @@ -15,6 +15,7 @@ import qualified LLVM.General.Internal.FFI.LLVMCTypes as FFI import LLVM.General.Internal.FFI.LLVMCTypes (typeKindP) import qualified LLVM.General.Internal.FFI.Type as FFI +import qualified LLVM.General.Internal.FFI.PtrHierarchy as FFI import qualified LLVM.General.AST as A import qualified LLVM.General.AST.AddrSpace as A diff --git a/test/LLVM/General/Test/Analysis.hs b/test/LLVM/General/Test/Analysis.hs new file mode 100644 --- /dev/null +++ b/test/LLVM/General/Test/Analysis.hs @@ -0,0 +1,67 @@ +module LLVM.General.Test.Analysis where + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit + +import LLVM.General.Test.Support + +import Control.Monad.Error + +import LLVM.General.Module +import LLVM.General.Context +import LLVM.General.Analysis + +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 + +import qualified LLVM.General.Relocation as R +import qualified LLVM.General.CodeModel as CM +import qualified LLVM.General.CodeGenOpt as CGO + +tests = testGroup "Analysis" [ + testGroup "Verifier" [ + testCase "Module" $ withContext $ \context -> do + let ast = Module "" Nothing Nothing [ + GlobalDefinition $ Function L.External V.Default CC.C [] VoidType (Name "foo") ([ + Parameter (IntegerType 32) (Name "x") [] + ],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 8 1), []) + ], + functionAttributes = [], + metadata = [] + } + ] ( + Do $ Ret Nothing [] + ) + ] + ] + Left s <- withModuleFromAST' context ast $ runErrorT . verify + s @?= "Call parameter type does not match function signature!\n\ + \i8 1\n\ + \ i32 call void @foo(i8 1)\n\ + \Broken module found, compilation terminated.\n\ + \Broken module found, compilation terminated.\n" + | False -- this test will cause an assertion if LLVM is compiled with assertions on. + ] + ] diff --git a/test/LLVM/General/Test/Tests.hs b/test/LLVM/General/Test/Tests.hs --- a/test/LLVM/General/Test/Tests.hs +++ b/test/LLVM/General/Test/Tests.hs @@ -12,6 +12,7 @@ import qualified LLVM.General.Test.Module as Module import qualified LLVM.General.Test.Optimization as Optimization import qualified LLVM.General.Test.Target as Target +import qualified LLVM.General.Test.Analysis as Analysis tests = testGroup "llvm-general" [ Constants.tests, @@ -23,5 +24,6 @@ Metadata.tests, Module.tests, Optimization.tests, - Target.tests + Target.tests, + Analysis.tests ]