c2hs 0.19.1 → 0.20.1
raw patch · 10 files changed
+67/−18 lines, 10 files
Files
- ChangeLog +7/−0
- c2hs.cabal +3/−2
- src/C2HS/CHS.hs +4/−1
- src/C2HS/CHS/Lexer.hs +9/−0
- src/Main.hs +8/−13
- tests/bugs/issue-113/Issue113.chs +8/−0
- tests/bugs/issue-113/issue113.c +0/−0
- tests/bugs/issue-113/issue113.h +1/−0
- tests/regression-suite.hs +23/−2
- tests/test-bugs.hs +4/−0
ChangeLog view
@@ -1,3 +1,10 @@+0.20.1+ - Get CUDA Travis tests working again (hopefully...)+ - Modify approach for defining C2HS_MIN_VERSION macro to work with+ NVIDIA's nvcc CUDA compiler [#111]+ - Fix problem with parser for {#enum ...#} renamings [#113]++ 0.19.1 - Add {#const ...#} hook for accessing #defined constants [#65] - Persist enumeration definitions across modules [#103]
c2hs.cabal view
@@ -1,5 +1,5 @@ Name: c2hs-Version: 0.19.1+Version: 0.20.1 License: GPL-2 License-File: COPYING Copyright: Copyright (c) 1999-2007 Manuel M T Chakravarty@@ -18,7 +18,7 @@ hsc2hs), this ensures that C functions are imported with the correct Haskell types. Category: Development-Tested-With: GHC==6.12.3, GHC==7.0.4, GHC==7.6.1, GHC==7.6.3+Tested-With: GHC==6.12.3, GHC==7.0.4, GHC==7.6.1, GHC==7.6.3, GHC==7.8.3 Cabal-Version: >= 1.8 Build-Type: Simple @@ -73,6 +73,7 @@ tests/bugs/issue-97/*.chs tests/bugs/issue-97/*.h tests/bugs/issue-97/*.c tests/bugs/issue-103/*.chs tests/bugs/issue-103/*.h tests/bugs/issue-103/*.c tests/bugs/issue-107/*.chs+ tests/bugs/issue-113/*.chs tests/bugs/issue-113/*.h tests/bugs/issue-113/*.c source-repository head type: git
src/C2HS/CHS.hs view
@@ -64,7 +64,8 @@ -- | `class' [ident `=>'] ident ident -- | `const' ident -- ctxt -> [`lib' `=' string] [prefix]--- idalias -> ident [`as' (ident | `^' | `'' ident1 ident2 ... `'')]+-- idalias -> ident+-- | looseident [`as' (ident | `^' | `'' ident1 ident2 ... `'')] -- prefix -> `prefix' `=' string [`add' `prefix' `=' string] -- deriving -> `deriving' `(' ident_1 `,' ... `,' ident_n `)' -- parms -> [verbhs `=>'] `{' parm_1 `,' ... `,' parm_n `}' `->' parm@@ -1434,6 +1435,8 @@ parseTranss toks' = syntaxError toks' -- parseAssoc (CHSTokIdent _ ide1:CHSTokAs _:CHSTokIdent _ ide2:toks') =+ return ((ide1, ide2), toks')+ parseAssoc (CHSTokCIdentTail _ ide1:CHSTokAs _:CHSTokIdent _ ide2:toks') = return ((ide1, ide2), toks') parseAssoc (CHSTokIdent _ _ :CHSTokAs _:toks' ) = syntaxError toks'
src/C2HS/CHS/Lexer.hs view
@@ -87,6 +87,7 @@ -- transfers control to the following binding-hook lexer: -- -- ident -> letter (letter | digit | `\'')*+-- cidenttail -> digit (letter | digit)* -- reservedid -> `add' | `as' | `call' | `class' | `context' | `deriving' -- | `enum' | `foreign' | `fun' | `get' | `lib' -- | `downcaseFirstLetter' | `finalizer'@@ -249,6 +250,7 @@ | CHSTokC Position String -- verbatim C code | CHSTokCtrl Position Char -- control code | CHSTokComment Position String -- comment+ | CHSTokCIdentTail Position Ident -- C identifier without prefix instance Pos CHSToken where posOf (CHSTokArrow pos ) = pos@@ -309,6 +311,7 @@ posOf (CHSTokC pos _) = pos posOf (CHSTokCtrl pos _) = pos posOf (CHSTokComment pos _) = pos+ posOf (CHSTokCIdentTail pos _) = pos instance Eq CHSToken where (CHSTokArrow _ ) == (CHSTokArrow _ ) = True@@ -369,6 +372,7 @@ (CHSTokC _ _) == (CHSTokC _ _) = True (CHSTokCtrl _ _) == (CHSTokCtrl _ _) = True (CHSTokComment _ _) == (CHSTokComment _ _) = True+ (CHSTokCIdentTail _ _) == (CHSTokCIdentTail _ _) = True _ == _ = False instance Show CHSToken where@@ -432,6 +436,7 @@ showsPrec _ (CHSTokComment _ s) = showString (if null s then "" else " --" ++ s ++ "\n")+ showsPrec _ (CHSTokCIdentTail _ i) = (showString . identToString) i -- lexer state -- -----------@@ -730,6 +735,10 @@ -- identifier or keyword (letter +> (letter >|< digit >|< char '\'')`star` epsilon `lexactionName` \cs pos name -> (idkwtok $!pos) cs name)+ >||<+ (digit +> (letter >|< digit)`star` epsilon+ `lexactionName` \cs pos name ->+ CHSTokCIdentTail pos (mkIdent pos cs name)) where idkwtok pos "add" _ = CHSTokAdd pos idkwtok pos "as" _ = CHSTokAs pos
src/Main.hs view
@@ -553,18 +553,14 @@ newHeaderFile = outDir </> newHeader preprocFile = outFPath <.> isuffix CIO.writeFile newHeaderFile $ concat $+ [ "#define C2HS_MIN_VERSION(mj,mn,rv) " +++ "((mj)<=C2HS_VERSION_MAJOR && " +++ "(mn)<=C2HS_VERSION_MINOR && " +++ "(rv)<=C2HS_VERSION_REV)\n" ] ++ [ "#include \"" ++ headerFile ++ "\"\n" | headerFile <- headerFiles ] ++ header'- --- -- Check if we can get away without having to keep a separate .chs.h file- --- case headerFiles of- [headerFile] | null header- -> setHeader headerFile -- the generated .hs file will directly- -- refer to this header rather than going- -- through a one-line .chs.h file.- _ -> setHeader newHeader+ setHeader newHeader -- -- run C preprocessor over the header --@@ -577,10 +573,9 @@ , "-U__GNUC_PATCHLEVEL__" ] else [] [versMajor, versMinor, versRev] = map show $ DV.versionBranch versnum- versionOpt = [ "-DC2HS_MIN_VERSION(mj,mn,rv)=" ++- "(mj<=" ++ versMajor ++ "&&" ++- "mn<=" ++ versMinor ++ "&&" ++- "rv<=" ++ versRev ++ ")" ]+ versionOpt = [ "-DC2HS_VERSION_MAJOR=" ++ versMajor+ , "-DC2HS_VERSION_MINOR=" ++ versMinor+ , "-DC2HS_VERSION_REV=" ++ versRev ] args = cppOpts ++ nonGNUOpts ++ ["-U__BLOCKS__"] ++ versionOpt ++ [newHeaderFile] tracePreproc (unwords (cpp:args))
+ tests/bugs/issue-113/Issue113.chs view
@@ -0,0 +1,8 @@+module Main where++#include "issue113.h"++{#enum annoying as Annoying {0 as Zero} with prefix = "annoying"#}++main :: IO ()+main = putStrLn "OK"
+ tests/bugs/issue-113/issue113.c view
+ tests/bugs/issue-113/issue113.h view
@@ -0,0 +1,1 @@+enum annoying { annoying_0 };
tests/regression-suite.hs view
@@ -6,6 +6,7 @@ import Control.Applicative ((<$>), (<*>)) import Control.Monad import Shelly hiding (FilePath)+import Data.Char import Data.List (nub) import Data.Text (Text) import Data.Monoid@@ -81,7 +82,8 @@ when (not (null specials)) $ do echo "SPECIAL INSTALL STEPS\n"- forM_ specials $ \s -> let (c:as) = T.words s in run_ (fromText c) as+ forM_ specials $ \s -> let (c:as) = escapedWords s in+ run_ (fromText c) as echo "\n" when (not (null extraPaths)) $ do@@ -100,9 +102,28 @@ Just efs -> infs ++ concatMap (\f -> ["-f", f]) (T.splitOn "," efs) echo $ "\nREGRESSION TEST: " <> n <> "\n" errExit False $ do- run_ "cabal" $ ["install", "--jobs=1"] ++ fs ++ [n]+ run_ "cabal" $ ["install", "--jobs=1", "-v"] ++ fs ++ [n] lastExitCode if all (== 0) codes then exit 0 else errorExit "SOME TESTS FAILED"++escapedWords :: Text -> [Text]+escapedWords = map (T.pack . reverse) . escWords False "" . T.unpack+ where escWords :: Bool -> String -> String -> [String]+ -- End of string: just return the accumulator if there is one.+ escWords _ acc "" = case acc of+ "" -> []+ _ -> [acc]+ -- Not escaping.+ escWords False acc (c:cs)+ | isSpace c = acc : escWords False "" cs+ | c == '\'' = case acc of+ "" -> escWords True "" cs+ _ -> acc : escWords True "" cs+ | otherwise = escWords False (c:acc) cs+ -- Escaping.+ escWords True acc (c:cs)+ | c == '\'' = acc : escWords False "" cs+ | otherwise = escWords True (c:acc) cs
tests/test-bugs.hs view
@@ -61,6 +61,7 @@ , testCase "Issue #97" issue97 , testCase "Issue #103" issue103 , testCase "Issue #107" issue107+ , testCase "Issue #113" issue113 ] ] @@ -74,6 +75,9 @@ res <- absPath "./Capital" >>= cmd let expected = ["upper C();", "lower c();", "upper C();"] liftIO $ assertBool "" (T.lines res == expected)++issue113 :: Assertion+issue113 = build_issue 113 issue107 :: Assertion issue107 = hs_only_expect_issue 107 ["True"]