1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
import Test.Framework (defaultMain, testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test, assert)
import Control.Monad.IO.Class
import Shelly
import qualified Shelly as Sh
import Prelude hiding (FilePath)
import Control.Monad (forM_)
import Data.Text (Text)
import Data.Monoid
import System.Info (os)
import qualified Data.Text as T
import Paths_c2hs
default (T.Text)
main :: IO ()
main = defaultMain tests
c2hsShelly :: MonadIO m => Sh a -> m a
c2hsShelly as = shelly $ do
oldpath <- get_env_text "PATH"
let newpath = "../../../dist/build/c2hs:" <> oldpath
setenv "PATH" newpath
as
cc :: FilePath
cc = if os == "cygwin32" || os == "mingw32" then "gcc" else "cc"
tests :: [Test]
tests =
[ testGroup "System"
[ testCase "Calls" test_calls
, testCase "Cpp" test_cpp
, testCase "Enums" test_enums
, testCase "Marsh" test_marsh
, testCase "Pointer" test_pointer
, testCase "Simple" test_simple
-- , testCase "Sizeof" test_sizeof -- KNOWN FAILURE: ISSUE #10
, testCase "Structs" test_structs
, testCase "Interruptible" test_interruptible
]
]
run_test_exit_code :: Sh.FilePath -> [(Sh.FilePath, [Text])] -> Assertion
run_test_exit_code dir cmds = c2hsShelly $ chdir dir $ do
forM_ (init cmds) $ \(c, as) -> run c as
errExit False $ run (fst $ last cmds) (snd $ last cmds)
code <- lastExitCode
liftIO $ assertBool "" (code == 0)
run_test_expect :: Sh.FilePath -> [(Sh.FilePath, [Text])] ->
Sh.FilePath -> [Text] -> Assertion
run_test_expect dir cmds expcmd expected = c2hsShelly $ chdir dir $ do
forM_ cmds $ \(c, as) -> run c as
res <- absPath expcmd >>= cmd
liftIO $ assertBool "" (T.lines res == expected)
test_calls :: Assertion
test_calls = run_test_exit_code "tests/system/calls"
[("c2hs", ["calls.h", "Calls.chs"]),
("ghc", ["-c", "Calls.hs"])]
test_cpp :: Assertion
test_cpp = run_test_exit_code "tests/system/cpp"
[("c2hs", ["Cpp.chs"]),
("ghc", ["-c", "Cpp.hs"])]
test_enums :: Assertion
test_enums = run_test_expect "tests/system/enums"
[("c2hs", ["enums.h", "Enums.chs"]),
(cc, ["-o", "enums_c.o", "-c", "enums.c"]),
("ghc", ["-o", "enums", "enums_c.o", "Enums.hs"])]
"./enums"
["Did it!"]
test_marsh :: Assertion
test_marsh = run_test_expect "tests/system/marsh"
[("c2hs", ["marsh.h", "Marsh.chs"]),
("ghc", ["-o", "marsh", "Marsh.hs"])]
"./marsh"
["Hello World!", "[5,3,7]"]
-- Issue #21
test_pointer :: Assertion
test_pointer = run_test_exit_code "tests/system/pointer"
[("c2hs", ["pointer.h", "Pointer.chs"]),
(cc, ["-o", "pointer_c.o", "-c", "pointer.c"]),
("ghc", ["-o", "pointer", "pointer_c.o", "Pointer.hs"])]
test_simple :: Assertion
test_simple = run_test_expect "tests/system/simple"
[("c2hs", ["simple.h", "Simple.chs"]),
("ghc", ["-c", "-o", "Simple_hs.o", "Simple.hs"]),
(cc, ["-c", "simple.c"]),
("ghc", ["-o", "simple", "simple.o", "Simple_hs.o"])]
"./simple"
["I am the mighty foo!"]
-- Issue #10
test_sizeof :: Assertion
test_sizeof = run_test_expect "tests/system/sizeof"
[("c2hs", ["sizeof.h", "Sizeof.chs"]),
("ghc", ["-c", "-o", "Sizeof.o", "Sizeof.hs"]),
(cc, ["-o", "sizeof_c.o", "-c", "sizeof.c"]),
("ghc", ["-o", "sizeof", "sizeof_c.o", "Sizeof.o"])]
"./sizeof"
["16 & 64 & 4 & 10",
"8 & 8 & 4 & 4"]
test_structs :: Assertion
test_structs = run_test_expect "tests/system/structs"
[("c2hs", ["structs.h", "Structs.chs"]),
("ghc", ["-c", "-o", "Structs.o", "Structs.hs"]),
(cc, ["-o", "structs_c.o", "-c", "structs.c"]),
("ghc", ["-o", "structs", "structs_c.o", "Structs.o"])]
"./structs"
["42 & -1 & 2 & 200 & ' '"]
test_interruptible :: Assertion
test_interruptible = run_test_expect "tests/system/interruptible"
[("c2hs", ["interruptible.h", "Interruptible.chs"]),
(cc, ["-o", "interruptible_c.o", "-c", "interruptible.c"]),
("ghc", ["-o", "interruptible", "interruptible_c.o", "Interruptible.hs"])]
"./interruptible"
["interrupted!"]
|
