diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -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] diff --git a/c2hs.cabal b/c2hs.cabal --- a/c2hs.cabal +++ b/c2hs.cabal @@ -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 diff --git a/src/C2HS/CHS.hs b/src/C2HS/CHS.hs --- a/src/C2HS/CHS.hs +++ b/src/C2HS/CHS.hs @@ -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' diff --git a/src/C2HS/CHS/Lexer.hs b/src/C2HS/CHS/Lexer.hs --- a/src/C2HS/CHS/Lexer.hs +++ b/src/C2HS/CHS/Lexer.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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)) diff --git a/tests/bugs/issue-113/Issue113.chs b/tests/bugs/issue-113/Issue113.chs new file mode 100644 --- /dev/null +++ b/tests/bugs/issue-113/Issue113.chs @@ -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" diff --git a/tests/bugs/issue-113/issue113.c b/tests/bugs/issue-113/issue113.c new file mode 100644 --- /dev/null +++ b/tests/bugs/issue-113/issue113.c diff --git a/tests/bugs/issue-113/issue113.h b/tests/bugs/issue-113/issue113.h new file mode 100644 --- /dev/null +++ b/tests/bugs/issue-113/issue113.h @@ -0,0 +1,1 @@ +enum annoying { annoying_0 }; diff --git a/tests/regression-suite.hs b/tests/regression-suite.hs --- a/tests/regression-suite.hs +++ b/tests/regression-suite.hs @@ -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 diff --git a/tests/test-bugs.hs b/tests/test-bugs.hs --- a/tests/test-bugs.hs +++ b/tests/test-bugs.hs @@ -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"]