{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -- | This module provides some simple pretty-printing output verification tests. -- This amounts to spot-checking a few places in the pretty printing that are -- examined by hand: in general, it its much more effective to do round-trip -- testing using AST's parsed from bitcode generated by actual programs, which is -- what occurs in the llvm-pretty-bc-parser package (i.e. much more comprehensive -- testing is deferred to the llvm-pretty-bc-parser package, which might then -- reveal issues that need to be fixed in this llvm-pretty package). module Output ( tests ) where import Control.Monad ( unless ) import qualified Data.Text as T import qualified Test.Tasty as Tasty import Test.Tasty.HUnit import qualified Text.PrettyPrint as PP import Text.LLVM.AST import Text.LLVM.PP import TQQDefs tests :: Tasty.TestTree tests = Tasty.testGroup "LLVM pretty-printing output tests" $ let -- s1 is a non-sensical construct whose primary intention is to hold two -- sub-structures that change their pretty representations at different -- LLVM versions. The pretty output will be checked at different LLVM -- versions to ensure that the desired version-specific changes in the -- output are seen. s1, s2 :: Stmt s1 = Effect (GEP True (Alias (Ident "hi")) (Typed Opaque dcu) []) [] s2 = Effect (Load PtrOpaque (Typed Opaque ValNull) Nothing Nothing) [ ("location", ValMdLoc $ DebugLoc { dlLine = 12 , dlCol = 34 , dlScope = ValMdRef 5 , dlIA = Nothing , dlImplicit = True }) ] dcu :: Value dcu = ValMd $ ValMdDebugInfo $ DebugInfoCompileUnit $ DICompileUnit { dicuLanguage = 12 , dicuFile = Nothing , dicuProducer = Just "llvm-pretty-test" , dicuIsOptimized = True , dicuFlags = Just "some flags" , dicuRuntimeVersion = 3 , dicuSplitDebugFilename = Nothing , dicuEmissionKind = 1 , dicuEnums = Just dtt , dicuRetainedTypes = Nothing , dicuSubprograms = Nothing , dicuGlobals = Nothing , dicuImports = Nothing , dicuMacros = Nothing , dicuDWOId = 2 , dicuSplitDebugInlining = False , dicuDebugInfoForProf = True , dicuNameTableKind = 4 , dicuRangesBaseAddress = True , dicuSysRoot = Just "the root" , dicuSDK = Just "SDK" } dtt = ValMdDebugInfo $ DebugInfoTemplateTypeParameter $ DITemplateTypeParameter { dittpName = Just "ttp" , dittpType = Nothing , dittpIsDefault = Just True } blk1 = BasicBlock { bbLabel = Just $ Named $ Ident "blk1" , bbStmts = [ Result (Ident "r1") (Comment "insanity follows...") [] , Effect (Jump $ Named $ Ident "blk1") [] , Result (Ident "oh no") RetVoid [] , Effect (Br (Typed (PrimType Metadata) ValZeroInit) (Anon 3) (Named "oh no")) [] ] } blk2 = BasicBlock { bbLabel = Just $ Anon 123 , bbStmts = [] } ppToText = T.pack -- render with a line-length of 30 to encourage wrapping on -- most list elements or arguments for consistent output to -- verify against any changes. . PP.renderStyle (PP.Style PP.PageMode 30 1.0) in [ testCase "Stmt 1, LLVM 3.5" $ assertEqLines [sq| ---- getelementptr inbounds opaque !DICompileUnit(language: 12, producer: "llvm-pretty-test", isOptimized: true, flags: "some flags", runtimeVersion: 3, emissionKind: 1, enums: !DITemplateTypeParameter(name: ttp), dwoId: 2, splitDebugInlining: false, debugInfoForProfiling: true, nameTableKind: 4) ---- |] (ppToText $ ppLLVM35 ppStmt s1) , testCase "Stmt 1, LLVM 3.7" $ assertEqLines [sq| In LLVM 3.7, the GEP instruction output shows the additional type ---- getelementptr inbounds %hi, opaque !DICompileUnit(language: 12, producer: "llvm-pretty-test", isOptimized: true, flags: "some flags", runtimeVersion: 3, emissionKind: 1, enums: !DITemplateTypeParameter(name: ttp), dwoId: 2, splitDebugInlining: false, debugInfoForProfiling: true, nameTableKind: 4) ---- |] (ppToText $ ppLLVM37 ppStmt s1) , testCase "Stmt 1, LLVM 10" $ assertEqLines (ppToText $ ppLLVM 10 $ ppStmt s1) [sq| No change from LLVM 3.7 through LLVM 10 ---- getelementptr inbounds %hi, opaque !DICompileUnit(language: 12, producer: "llvm-pretty-test", isOptimized: true, flags: "some flags", runtimeVersion: 3, emissionKind: 1, enums: !DITemplateTypeParameter(name: ttp), dwoId: 2, splitDebugInlining: false, debugInfoForProfiling: true, nameTableKind: 4) ---- |] , testCase "Stmt 1, LLVM 11" $ assertEqLines (ppToText $ ppLLVM 11 $ ppStmt s1) [sq| In LLVM 11, DICompileUnit adds rangesBaseAddress, sysroot, and sdk ---- getelementptr inbounds %hi, opaque !DICompileUnit(language: 12, producer: "llvm-pretty-test", isOptimized: true, flags: "some flags", runtimeVersion: 3, emissionKind: 1, enums: !DITemplateTypeParameter(name: ttp), dwoId: 2, splitDebugInlining: false, debugInfoForProfiling: true, nameTableKind: 4, rangesBaseAddress: true, sysroot: "the root", sdk: "SDK") ---- |] ------------------------------------------------------------ , testCase "Stmt 2, LLVM 3.5" $ assertEqLines [sq| ---- load opaque null, !location !MDLocation(line: 12, column: 34, scope: !5, implicit) ---- |] (ppToText $ ppLLVM35 ppStmt s2) , testCase "Stmt 2, LLVM 3.7" $ assertEqLines [sq| Beginning in LLVM 3.7, the type is no longer implicit and is explicitly shown, and the DebugLoc metadata is DILocation instead of MDLocation ---- load ptr, opaque null, !location !DILocation(line: 12, column: 34, scope: !5, implicit) ---- |] (ppToText $ ppLLVM37 ppStmt s2) , testCase "Stmt 2, LLVM 10" $ assertEqLines [sq| No change since LLVM 3.7 ---- load ptr, opaque null, !location !DILocation(line: 12, column: 34, scope: !5, implicit) ---- |] (ppToText $ ppLLVM 10 $ ppStmt s2) ------------------------------------------------------------ -- Verify named labels and label targets are emitted correctly , testCase "Blk 1, LLVM 3.5" $ assertEqLines (ppToText $ ppLLVM35 ppBasicBlock blk1) [sq| -------- blk1: %r1 = ; insanity follows... br label %blk1 %"oh no" = ret void br metadata zeroinitializer, label %3, label %"oh no" -------- |] , testCase "Blk 1, LLVM 3.7" $ assertEqLines (ppToText $ ppLLVM37 ppBasicBlock blk1) [sq| -------- blk1: %r1 = ; insanity follows... br label %blk1 %"oh no" = ret void br metadata zeroinitializer, label %3, label %"oh no" -------- |] ------------------------------------------------------------ -- Verify anonymous labels are emitted correctly , testCase "Blk 2, LLVM 3.5" $ assertEqLines (ppToText $ ppLLVM35 ppBasicBlock blk2) [sq| -------- ;