language-c-quote 0.4.3 → 0.4.4

raw patch · 7 files changed

+98/−68 lines, 7 filesdep +test-frameworkdep +test-framework-hunitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: test-framework, test-framework-hunit

API changes (from Hackage documentation)

Files

• Language/C/Parser/Parser.y +7/−0
• Language/C/Parser/Tokens.hs +3/−0
• Language/C/Pretty.hs +2/−1
• Language/C/Quote/CUDA.hs +2/−2
• Language/C/Syntax.hs +2/−0
• language-c-quote.cabal +7/−5
• tests/unit/Main.hs +75/−60

@@ -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

@@ -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]),

@@ -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)

@@ -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]

@@ -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

@@ -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

@@ -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|]