diff --git a/Language/C/Parser/Parser.y b/Language/C/Parser/Parser.y --- a/Language/C/Parser/Parser.y +++ b/Language/C/Parser/Parser.y @@ -145,6 +145,7 @@ '__host__' { L _ T.TCUDAhost } '__constant__' { L _ T.TCUDAconstant } '__shared__' { L _ T.TCUDAshared } + '__restrict__' { L _ T.TCUDArestrict } '__noinline__' { L _ T.TCUDAnoinline } 'private' { L _ T.TCLprivate } @@ -946,6 +947,7 @@ | '__host__' { TSCUDAhost (srclocOf $1) } | '__constant__' { TSCUDAconstant (srclocOf $1) } | '__shared__' { TSCUDAshared (srclocOf $1) } + | '__restrict__' { TSCUDArestrict (srclocOf $1) } | '__noinline__' { TSCUDAnoinline (srclocOf $1) } {- Extension: OpenCL -} @@ -1788,6 +1790,7 @@ | TSCUDAhost !SrcLoc | TSCUDAconstant !SrcLoc | TSCUDAshared !SrcLoc + | TSCUDArestrict !SrcLoc | TSCUDAnoinline !SrcLoc -- OpenCL @@ -1842,6 +1845,7 @@ locOf (TSCUDAhost loc) = locOf loc locOf (TSCUDAconstant loc) = locOf loc locOf (TSCUDAshared loc) = locOf loc + locOf (TSCUDArestrict loc) = locOf loc locOf (TSCUDAnoinline loc) = locOf loc locOf (TSCLprivate loc) = locOf loc @@ -1896,6 +1900,7 @@ ppr (TSCUDAhost _) = text "__host__" ppr (TSCUDAconstant _) = text "__constant__" ppr (TSCUDAshared _) = text "__shared__" + ppr (TSCUDArestrict _) = text "__restrict__" ppr (TSCUDAnoinline _) = text "__noinline__" ppr (TSCLprivate _) = text "__private" @@ -1937,6 +1942,7 @@ isTypeQual (TSCUDAhost _) = True isTypeQual (TSCUDAconstant _) = True isTypeQual (TSCUDAshared _) = True +isTypeQual (TSCUDArestrict _) = True isTypeQual (TSCUDAnoinline _) = True isTypeQual (TSCLprivate _) = True isTypeQual (TSCLlocal _) = True @@ -1960,6 +1966,7 @@ mk (TSCUDAhost loc) = TCUDAhost loc mk (TSCUDAconstant loc) = TCUDAconstant loc mk (TSCUDAshared loc) = TCUDAshared loc + mk (TSCUDArestrict loc) = TCUDArestrict loc mk (TSCUDAnoinline loc) = TCUDAnoinline loc mk (TSCLprivate loc) = TCLprivate loc mk (TSCLlocal loc) = TCLlocal loc diff --git a/Language/C/Parser/Tokens.hs b/Language/C/Parser/Tokens.hs --- a/Language/C/Parser/Tokens.hs +++ b/Language/C/Parser/Tokens.hs @@ -139,6 +139,7 @@ | TCUDAhost | TCUDAconstant | TCUDAshared + | TCUDArestrict | TCUDAnoinline -- OpenCL @@ -313,6 +314,7 @@ (TCUDAhost, "__host__"), (TCUDAconstant, "__constant__"), (TCUDAshared, "__shared__"), + (TCUDArestrict, "__restrict__"), (TCUDAnoinline, "__noinline__"), -- @@ -389,6 +391,7 @@ ("__host__", TCUDAhost, Just [CUDA]), ("__constant__", TCUDAconstant, Just [CUDA]), ("__shared__", TCUDAshared, Just [CUDA]), + ("__restrict__", TCUDArestrict, Just [CUDA]), ("__noinline__", TCUDAnoinline, Just [CUDA]), ("private", TCLprivate, Just [OpenCL]), diff --git a/Language/C/Pretty.hs b/Language/C/Pretty.hs --- a/Language/C/Pretty.hs +++ b/Language/C/Pretty.hs @@ -136,6 +136,7 @@ ppr (TCUDAhost _) = text "__host__" ppr (TCUDAconstant _) = text "__constant__" ppr (TCUDAshared _) = text "__shared__" + ppr (TCUDArestrict _) = text "__restrict__" ppr (TCUDAnoinline _) = text "__noinline__" ppr (TCLprivate _) = text "__private" @@ -269,7 +270,7 @@ text "*" <> post pprPtr (Ptr quals decl _) post = pprPtr decl $ - text "*" <> spread (map ppr quals) <+> post + text "*" <+> spread (map ppr quals) <> post pprPtr decl post = (decl, post) pprDirDecl :: Decl -> Doc -> (Decl, Doc) diff --git a/Language/C/Quote/CUDA.hs b/Language/C/Quote/CUDA.hs --- a/Language/C/Quote/CUDA.hs +++ b/Language/C/Quote/CUDA.hs @@ -31,8 +31,8 @@ typenames = concatMap (typeN 4) ["char", "uchar", "short", "ushort", "int", "uint", "long", "ulong", - "float"] ++ - concatMap (typeN 2) ["longlong", "double"] ++ + "longlong", "ulonglong", + "float", "double"] ++ ["dim3"] typeN :: Int -> String -> [String] diff --git a/Language/C/Syntax.hs b/Language/C/Syntax.hs --- a/Language/C/Syntax.hs +++ b/Language/C/Syntax.hs @@ -46,6 +46,7 @@ | TCUDAhost !SrcLoc | TCUDAconstant !SrcLoc | TCUDAshared !SrcLoc + | TCUDArestrict !SrcLoc | TCUDAnoinline !SrcLoc -- OpenCL @@ -350,6 +351,7 @@ locOf (TCUDAhost loc) = locOf loc locOf (TCUDAconstant loc) = locOf loc locOf (TCUDAshared loc) = locOf loc + locOf (TCUDArestrict loc) = locOf loc locOf (TCUDAnoinline loc) = locOf loc locOf (TCLprivate loc) = locOf loc diff --git a/language-c-quote.cabal b/language-c-quote.cabal --- a/language-c-quote.cabal +++ b/language-c-quote.cabal @@ -1,5 +1,5 @@ name: language-c-quote -version: 0.4.3 +version: 0.4.4 cabal-version: >= 1.10 license: BSD3 license-file: LICENSE @@ -72,11 +72,13 @@ default-language: Haskell98 build-depends: - HUnit >= 1.2 && < 1.3, - base >= 4 && < 5, + HUnit >= 1.2 && < 1.3, + base >= 4 && < 5, language-c-quote, - srcloc >= 0.2 && < 0.4, - symbol >= 0.1 && < 0.2 + srcloc >= 0.2 && < 0.4, + symbol >= 0.1 && < 0.2, + test-framework >= 0.8 && < 0.9, + test-framework-hunit >= 0.3 && < 0.4 source-repository head type: git diff --git a/tests/unit/Main.hs b/tests/unit/Main.hs --- a/tests/unit/Main.hs +++ b/tests/unit/Main.hs @@ -3,7 +3,9 @@ module Main where -import Test.HUnit +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit ((@=?)) import Language.C.Quote.C import System.Exit (exitFailure, exitSuccess) @@ -14,143 +16,156 @@ import qualified Language.C.Syntax #endif /* !MIN_VERSION_template_haskell(2,7,0) */ -main = do - count <- runTestTT tests - case failures count of - 0 -> exitSuccess - _ -> exitFailure - -tests = TestList [exp_id, exp_int, exp_float, exp_char, exp_string, - exp_exp, exp_func, exp_args, exp_decl, exp_sdecl, - exp_enum, exp_edecl, exp_stm, exp_param, exp_ty, - pat_args, exp_hexp] +main :: IO () +main = defaultMain tests +tests :: [Test] +tests = [exp_id, exp_int, exp_float, exp_char, exp_string, + exp_exp, exp_func, exp_args, exp_decl, exp_sdecl, + exp_enum, exp_edecl, exp_stm, exp_param, exp_ty, + pat_args, exp_hexp] -exp_id = "exp id" ~: [cexp|$id:ident|] ~?= [cexp|x|] +exp_id :: Test +exp_id = testCase "exp id" $ [cexp|$id:ident|] @=? [cexp|x|] where ident = "x" -exp_int = - "exp int" ~: [cexp|$int:one + $uint:one + $lint:one + $ulint:one|] - ~?= [cexp|1 + 1U + 1L + 1UL|] +exp_int :: Test +exp_int = testCase "exp int" $ + [cexp|$int:one + $uint:one + $lint:one + $ulint:one|] + @=? [cexp|1 + 1U + 1L + 1UL|] where one = 1 -exp_float = - "exp float" ~: [cexp|$float:one + $double:one + $ldouble:one|] - ~?= [cexp|1.0F + 1.0 + 1.0L|] +exp_float :: Test +exp_float = testCase "exp float" $ + [cexp|$float:one + $double:one + $ldouble:one|] + @=? [cexp|1.0F + 1.0 + 1.0L|] where one = 1 -exp_char = "exp char" ~: [cexp|$char:a|] ~?= [cexp|'a'|] +exp_char :: Test +exp_char = testCase "exp char" $ [cexp|$char:a|] @=? [cexp|'a'|] where a = 'a' +exp_string :: Test exp_string = - "exp string" ~: [cexp|$string:hello|] ~?= [cexp|"Hello, world\n"|] + testCase "exp string" $ [cexp|$string:hello|] @=? [cexp|"Hello, world\n"|] where hello = "Hello, world\n" +exp_exp :: Test exp_exp = - "exp expression" ~: [cexp|$exp:e1 + $exp:e2|] ~?= [cexp|1 + 2|] + testCase "exp expression" $ [cexp|$exp:e1 + $exp:e2|] @=? [cexp|1 + 2|] where e1 = [cexp|1|] e2 = [cexp|2|] -exp_func = - "exp function" ~: [cunit|$func:f|] - ~?= [cunit|int add(int x) { return x + 10; }|] +exp_func :: Test +exp_func = testCase "exp function" $ + [cunit|$func:f|] + @=? [cunit|int add(int x) { return x + 10; }|] where f = add 10 add n = [cfun|int add(int x) { return x + $int:n; } |] -exp_args = - "exp args" ~: [cstm|f($exp:e1, $args:args, $exp:e2);|] - ~?= [cstm|f(1, 1, 2, 2);|] +exp_args :: Test +exp_args = testCase "exp args" $ + [cstm|f($exp:e1, $args:args, $exp:e2);|] + @=? [cstm|f(1, 1, 2, 2);|] where e1 = [cexp|1|] e2 = [cexp|2|] args = [e1, e2] -exp_decl = - "exp decl" ~: [cfun|int inc(int n) { - $decl:d1; - $decls:decls +exp_decl :: Test +exp_decl = testCase "exp decl" $ + [cfun|int inc(int n) { + $decl:d1; + $decls:decls - return n + 1; - }|] - ~?= [cfun|int inc(int n) { - int i; - int j; - char c = 'c'; + return n + 1; + }|] + @=? [cfun|int inc(int n) { + int i; + int j; + char c = 'c'; - return n + 1; - }|] + return n + 1; + }|] where d1 = [cdecl|int i;|] d2 = [cdecl|int j;|] d3 = [cdecl|char c = 'c';|] decls = [d2, d3] -exp_sdecl = - "exp sdecl" ~: [cty|struct foo { $sdecl:d1 $sdecls:decls }|] - ~?= [cty|struct foo { int i; int j; char c; }|] +exp_sdecl :: Test +exp_sdecl = testCase "exp sdecl" $ + [cty|struct foo { $sdecl:d1 $sdecls:decls }|] + @=? [cty|struct foo { int i; int j; char c; }|] where d1 = [csdecl|int i;|] d2 = [csdecl|int j;|] d3 = [csdecl|char c;|] decls = [d2, d3] -exp_enum = "exp enum" ~: [cty|enum foo { $enum:enum1, $enums:enums }|] - ~?= [cty|enum foo { A = 0, B, C = 2 }|] +exp_enum :: Test +exp_enum = testCase "exp enum" $ + [cty|enum foo { $enum:enum1, $enums:enums }|] + @=? [cty|enum foo { A = 0, B, C = 2 }|] where enum1 = [cenum|A = 0|] enum2 = [cenum|B|] enum3 = [cenum|C = 2|] enums = [enum2, enum3] -exp_edecl = - "exp edecl" ~: [cunit|$edecl:d1 $edecls:decls|] - ~?= [cunit|int i; int j; char c = 'c';|] +exp_edecl :: Test +exp_edecl = testCase "exp edecl" $ + [cunit|$edecl:d1 $edecls:decls|] + @=? [cunit|int i; int j; char c = 'c';|] where d1 = [cedecl|int i;|] d2 = [cedecl|int j;|] d3 = [cedecl|char c = 'c';|] decls = [d2, d3] -exp_stm = - "exp stm" ~: [cfun|int add(int x) { $stms:stms return x + 1; }|] - ~?= [cfun|int add(int x) { a = 1; b = 2; return x + 1; }|] +exp_stm :: Test +exp_stm = testCase "exp stm" $ + [cfun|int add(int x) { $stms:stms return x + 1; }|] + @=? [cfun|int add(int x) { a = 1; b = 2; return x + 1; }|] where one = 1 stm1 = [cstm|a = $int:one;|] stm2 = [cstm|b = 2;|] stms = [stm1, stm2] -exp_param = - "exp param" ~: [cdecl|int f($param:ty1, $params:tys);|] - ~?= [cdecl|int f(char, int, float);|] +exp_param :: Test +exp_param = testCase "exp param" $ + [cdecl|int f($param:ty1, $params:tys);|] + @=? [cdecl|int f(char, int, float);|] where ty1 = [cparam|char|] ty2 = [cparam|int|] ty3 = [cparam|float|] tys = [ty2, ty3] -exp_ty = - "exp ty" ~: [cdecl|$ty:ty1 f(const $ty:ty2);|] - ~?= [cdecl|int f(const float);|] +exp_ty :: Test +exp_ty = testCase "exp ty" $ + [cdecl|$ty:ty1 f(const $ty:ty2);|] + @=? [cdecl|int f(const float);|] where ty1 = [cty|int|] ty2 = [cty|float|] +pat_args :: Test pat_args = - "pat args" ~: stms - ~?= [[cexp|2|], [cexp|3|]] + testCase"pat args" $ stms @=? [[cexp|2|], [cexp|3|]] where stms = case [cstm|f(1, 2, 3);|] of [cstm|f(1, $args:es);|] -> es _ -> [] +exp_hexp :: Test exp_hexp = - "exp hexp" ~: [cexp|$ulint:(13 - 2*5)|] - ~?= [cexp|3UL|] + testCase "exp hexp" $ [cexp|$ulint:(13 - 2*5)|] @=? [cexp|3UL|]