Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 7db76ec

Browse files
committed
Add tests
1 parent c79f928 commit 7db76ec

File tree

8 files changed

+209
-0
lines changed

8 files changed

+209
-0
lines changed

‎data-bitcode-llvm.cabal‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -73,3 +73,18 @@ library
7373
Data.BitCode.LLVM.Value
7474
Data.BitCode.LLVM.Visibility
7575
default-language: Haskell2010
76+
77+
test-suite spec
78+
main-is: Tasty.hs
79+
hs-source-dirs: test
80+
ghc-options: -Wall -threaded
81+
type: exitcode-stdio-1.0
82+
build-depends: base
83+
, tasty
84+
, tasty-discover
85+
, tasty-hspec
86+
, process
87+
, filepath
88+
, data-bitcode
89+
, data-bitcode-llvm
90+
default-language: Haskell2010

‎test/LLVMSpec.hs‎

Lines changed: 152 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,152 @@
1+
module LLVMSpec where
2+
3+
import Test.Tasty.Hspec
4+
5+
import Data.BitCode as BC
6+
import Data.BitCode.Reader as BC
7+
import Data.BitCode.LLVM.FromBitCode as BC
8+
import Data.BitCode.LLVM as LLVM
9+
import Data.BitCode.LLVM.Reader.Monad as LLVM
10+
import qualified Data.BitCode.LLVM.Instruction as I
11+
import qualified Data.BitCode.LLVM.Function as F
12+
import qualified Data.BitCode.Writer.Monad as BCM (writeFile)
13+
import Data.BitCode.Writer (emitTopLevel)
14+
import Data.Maybe (catMaybes)
15+
import Data.BitCode.LLVM.ToBitCode (toBitCode)
16+
import Data.BitCode.Writer.Combinators (withHeader)
17+
18+
import System.Process (readProcessWithExitCode)
19+
import System.Exit (ExitCode(ExitSuccess))
20+
import System.FilePath ((-<.>))
21+
import Data.Either (isRight)
22+
23+
writeFile' :: FilePath -> [BitCode] -> IO ()
24+
writeFile' fp = BCM.writeFile fp . withHeader True . emitTopLevel
25+
26+
compile :: FilePath -> IO FilePath
27+
compile f = do
28+
(exit, _out, _err) <- readProcessWithExitCode
29+
"clang"
30+
[ "-w" -- no warnings
31+
, "-emit-llvm"
32+
, "-c"
33+
, f
34+
, "-o"
35+
, fout ]
36+
"" --stdin
37+
case exit of
38+
ExitSuccess -> return fout
39+
err -> error $ show err
40+
where
41+
fout = f -<.> "bc"
42+
43+
decompile :: FilePath -> IO FilePath
44+
decompile f = do
45+
(exit, _out, _err) <- readProcessWithExitCode
46+
"llvm-dis"
47+
[ "-o"
48+
, fout
49+
, f ]
50+
"" --stdin
51+
case exit of
52+
ExitSuccess -> return fout
53+
err -> error $ show err
54+
where
55+
fout = f -<.> "dis"
56+
57+
readBitcode :: FilePath -> IO (Either String (Maybe Ident, Module))
58+
readBitcode f = do
59+
res <- BC.readFile f
60+
return $ (evalLLVMReader . parseTopLevel . catMaybes . map normalize) =<< res
61+
62+
moduleInstructions :: Module -> [I.Inst]
63+
moduleInstructions m =
64+
concatMap funcInsts (LLVM.mFns m)
65+
where
66+
funcInsts = concatMap blockInsts . F.dBody
67+
blockInsts :: F.BasicBlock -> [I.Inst]
68+
blockInsts (F.BasicBlock insts) = map snd insts
69+
blockInsts (F.NamedBlock _ insts) = map snd insts
70+
71+
-- Note: we often do not try to "write", as building
72+
-- up modules by hand is rather hard. However
73+
-- building modules is usually done with the
74+
-- LLVM EDSL, and as such tests for writing modules
75+
-- should be done there.
76+
77+
isModule :: Either String (Maybe Ident, Module) -> Bool
78+
isModule = isRight
79+
80+
81+
isCmpXchg :: I.Inst -> Bool
82+
isCmpXchg (I.CmpXchg{}) = True
83+
isCmpXchg _ = False
84+
85+
isFence :: I.Inst -> Bool
86+
isFence (I.Fence{}) = True
87+
isFence _ = False
88+
89+
isAtomicRMW :: I.Inst -> Bool
90+
isAtomicRMW (I.AtomicRMW{}) = True
91+
isAtomicRMW _ = False
92+
93+
isAtomicLoad :: I.Inst -> Bool
94+
isAtomicLoad (I.AtomicLoad{}) = True
95+
isAtomicLoad _ = False
96+
97+
isAtomicStore :: I.Inst -> Bool
98+
isAtomicStore (I.AtomicStore{}) = True
99+
isAtomicStore _ = False
100+
101+
spec_llvm :: Spec
102+
spec_llvm = do
103+
describe "fromBitcode" $ do
104+
it "should be able to read CMPXCHG" $ do
105+
bcfile <- compile "test/fromBitcode/cmpxchg.ll"
106+
ret <- readBitcode bcfile
107+
ret `shouldSatisfy` isModule
108+
let Right (_mbIdent, mod) = ret
109+
moduleInstructions mod `shouldSatisfy` (any isCmpXchg)
110+
111+
it "should be able to roundtrip CMPXCHG" $ do
112+
bcfile <- compile "test/fromBitcode/cmpxchg.ll"
113+
ret <- readBitcode bcfile
114+
ret `shouldSatisfy` isModule
115+
let Right mod = ret
116+
writeFile' bcfile . map denormalize $ toBitCode mod
117+
ret <- readBitcode bcfile
118+
ret `shouldSatisfy` isModule
119+
decompile bcfile `shouldReturn` "test/fromBitcode/cmpxchg.dis"
120+
121+
it "should be able to read FENCE" $ do
122+
bcfile <- compile "test/fromBitcode/fence.ll"
123+
ret <- readBitcode bcfile
124+
ret `shouldSatisfy` isModule
125+
let Right (_mbIdent, mod) = ret
126+
moduleInstructions mod `shouldSatisfy` (any isFence)
127+
128+
-- xit "should be able to roundtrip FENCE"
129+
it "should be able to read ATOMIC RMW" $ do
130+
bcfile <- compile "test/fromBitcode/atomicrmw.ll"
131+
ret <- readBitcode bcfile
132+
ret `shouldSatisfy` isModule
133+
let Right (_mbIdent, mod) = ret
134+
moduleInstructions mod `shouldSatisfy` (any isAtomicRMW)
135+
136+
-- xit "should be able to roundtrip ATOMIC RMW"
137+
it "should be able to read LOAD ATOMIC" $ do
138+
bcfile <- compile "test/fromBitcode/atomicload.ll"
139+
ret <- readBitcode bcfile
140+
ret `shouldSatisfy` isModule
141+
let Right (_mbIdent, mod) = ret
142+
moduleInstructions mod `shouldSatisfy` (any isAtomicLoad)
143+
144+
-- xit "should be able to roundtrip LOAD ATOMIC"
145+
it "should be able to read STORE ATOMIC" $ do
146+
bcfile <- compile "test/fromBitcode/atomicstore.ll"
147+
ret <- readBitcode bcfile
148+
ret `shouldSatisfy` isModule
149+
let Right (_mbIdent, mod) = ret
150+
moduleInstructions mod `shouldSatisfy` (any isAtomicStore)
151+
152+
-- xit "should be able to roundtrip STORE ATOMIC"

‎test/Tasty.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-}
2+

‎test/fromBitcode/atomicload.ll‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
define i32 @main() {
2+
%ptr = alloca i32
3+
store i32 0, i32* %ptr
4+
%val = load atomic i32, i32* %ptr seq_cst, align 4
5+
ret i32 %val
6+
}

‎test/fromBitcode/atomicrmw.ll‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
define i32 @main() {
2+
%ptr = alloca i32
3+
store i32 0, i32* %ptr
4+
5+
%old = atomicrmw add i32* %ptr, i32 1 acquire
6+
7+
ret i32 %old
8+
}

‎test/fromBitcode/atomicstore.ll‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
define i32 @main() {
2+
%ptr = alloca i32
3+
store atomic i32 0, i32* %ptr seq_cst, align 8
4+
%val = load i32, i32* %ptr
5+
ret i32 %val
6+
}

‎test/fromBitcode/cmpxchg.ll‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,15 @@
1+
2+
define i32 @main() {
3+
%ptr = alloca i32
4+
%ptr2 = alloca i32
5+
store i32 1, i32* %ptr
6+
store i32 2, i32* %ptr2
7+
%val = load i32, i32* %ptr
8+
%val2 = load i32, i32* %ptr2
9+
%squared = mul i32 %val2, %val2
10+
11+
cmpxchg i32* %ptr, i32 %val, i32 %squared acq_rel monotonic
12+
13+
%ret = load i32, i32* %ptr
14+
ret i32 %ret
15+
}

‎test/fromBitcode/fence.ll‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
define i32 @main() {
2+
fence acquire
3+
fence syncscope("singlethread") seq_cst
4+
ret i32 0
5+
}

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /