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
|
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}
module Language.C.Inline.ContextSpec (spec) where
import Control.Monad.Trans.Class (lift)
import Data.Word
import qualified Data.Map as Map
import qualified Test.Hspec as Hspec
import Text.Parser.Char
import Text.Parser.Combinators
import qualified Language.Haskell.TH as TH
import Foreign.C.Types
import Foreign.Ptr (Ptr, FunPtr)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<*), (*>))
#endif
import qualified Language.C.Types as C
import qualified Language.C.Types.Parse as P
import Language.C.Inline.Context
import GHC.Exts( IsString(..) )
data Vec a
data Ary a
spec :: Hspec.SpecWith ()
spec = do
Hspec.it "converts simple type correctly (1)" $ do
shouldBeType (cty "int") [t| CInt |]
Hspec.it "converts simple type correctly (2)" $ do
shouldBeType (cty "char") [t| CChar |]
Hspec.it "converts bool" $ do
shouldBeType (cty "bool") [t| CBool |]
Hspec.it "converts void" $ do
shouldBeType (cty "void") [t| () |]
Hspec.it "converts signed" $ do
shouldBeType (cty "signed") [t| CInt |]
Hspec.it "converts unsigned" $ do
shouldBeType (cty "unsigned") [t| CUInt |]
Hspec.it "converts standard library types (1)" $ do
shouldBeType (cty "FILE") [t| CFile |]
Hspec.it "converts standard library types (2)" $ do
shouldBeType (cty "uint16_t") [t| Word16 |]
Hspec.it "converts standard library types (3)" $ do
shouldBeType (cty "jmp_buf") [t| CJmpBuf |]
Hspec.it "converts single ptr type" $ do
shouldBeType (cty "long*") [t| Ptr CLong |]
Hspec.it "converts double ptr type" $ do
shouldBeType (cty "unsigned long**") [t| Ptr (Ptr CULong) |]
Hspec.it "converts arrays" $ do
shouldBeType (cty "double[]") [t| CArray CDouble |]
Hspec.it "converts named things" $ do
shouldBeType (cty "unsigned int foo[]") [t| CArray CUInt |]
Hspec.it "converts arrays of pointers" $ do
shouldBeType
(cty "unsigned short *foo[]") [t| CArray (Ptr CUShort) |]
Hspec.it "ignores qualifiers" $ do
shouldBeType (cty "const short*") [t| Ptr CShort |]
Hspec.it "ignores storage information" $ do
shouldBeType (cty "extern unsigned long") [t| CULong |]
Hspec.it "converts sized arrays" $ do
shouldBeType (cty "float[4]") [t| CArray CFloat |]
Hspec.it "converts variably sized arrays" $ do
shouldBeType (cty "float[*]") [t| CArray CFloat |]
Hspec.it "converts function pointers" $ do
shouldBeType
(cty "int (*f)(unsigned char, float)")
[t| FunPtr (CUChar -> CFloat -> IO CInt) |]
Hspec.it "converts complicated function pointers (1)" $ do
-- pointer to function returning pointer to function returning int
shouldBeType
(cty "int (*(*)())()") [t| FunPtr (IO (FunPtr (IO CInt))) |]
Hspec.it "converts complicated function pointerst (2)" $ do
-- foo is an array of pointer to pointer to function returning
-- pointer to array of pointer to char
shouldBeType
(cty "char *(*(**foo [])())[]")
[t| CArray (Ptr (FunPtr (IO (Ptr (CArray (Ptr CChar)))))) |]
Hspec.it "converts complicated function pointers (3)" $ do
-- foo is an array of pointer to pointer to function taking int
-- returning pointer to array of pointer to char
shouldBeType
(cty "char *(*(**foo [])(int x))[]")
[t| CArray (Ptr (FunPtr (CInt -> IO (Ptr (CArray (Ptr CChar)))))) |]
Hspec.it "converts vector" $ do
shouldBeType (cty "vector<int>") [t| Vec CInt |]
Hspec.it "converts std::vector" $ do
shouldBeType (cty "std::vector<int>") [t| Vec CInt |]
Hspec.it "converts std::vector*" $ do
shouldBeType (cty "std::vector<int>*") [t| Ptr (Vec CInt) |]
Hspec.it "converts array" $ do
shouldBeType (cty "array<int,10>") [t| Ary '(CInt,10) |]
Hspec.it "converts array*" $ do
shouldBeType (cty "array<int,10>*") [t| Ptr (Ary '(CInt,10)) |]
where
goodConvert cTy = do
mbHsTy <- TH.runQ $ convertType IO baseTypes cTy
case mbHsTy of
Nothing -> error $ "Could not convert type (goodConvert)"
Just hsTy -> return hsTy
shouldBeType cTy hsTy = do
x <- goodConvert cTy
y <- TH.runQ hsTy
x `Hspec.shouldBe` y
assertParse p s =
case C.runCParser (C.cCParserContext True (typeNamesFromTypesTable baseTypes)) "spec" s (lift spaces *> p <* lift eof) of
Left err -> error $ "Parse error (assertParse): " ++ show err
Right x -> x
cty s = C.parameterDeclarationType $ assertParse C.parseParameterDeclaration s
baseTypes = ctxTypesTable baseCtx `mappend` Map.fromList [
(C.TypeName (fromString "vector" :: P.CIdentifier), [t|Vec|]),
(C.TypeName (fromString "std::vector" :: P.CIdentifier), [t|Vec|]),
(C.TypeName (fromString "array" :: P.CIdentifier), [t|Ary|])
]
|
