c2hs 0.16.6 → 0.17.1
raw patch · 8 files changed
+144/−105 lines, 8 filesdep ~shelly
Dependency ranges changed: shelly
Files
- ChangeLog +6/−0
- c2hs.cabal +3/−3
- src/C2HS/CHS.hs +87/−62
- src/C2HS/CHS/Lexer.hs +3/−1
- src/C2HS/Gen/Bind.hs +25/−23
- src/C2HS/Gen/Header.hs +4/−4
- tests/test-bugs.hs +12/−8
- tests/test-system.hs +4/−4
ChangeLog view
@@ -1,3 +1,9 @@+0.17.1++ - Fix regressions from 0.16.6 (caused by fix for issue #45)+ - Version number bump (should have been done in the last release)++ 0.16.6 - Trivial integer casts in enum defines supporting typedefs [Anton Dessiatov]
c2hs.cabal view
@@ -1,5 +1,5 @@ Name: c2hs-Version: 0.16.6+Version: 0.17.1 License: GPL-2 License-File: COPYING Copyright: Copyright (c) 1999-2007 Manuel M T Chakravarty@@ -120,7 +120,7 @@ test-framework, test-framework-hunit, HUnit,- shelly >= 0.15.4.1 && < 1.0,+ shelly >= 1.0, text Test-Suite test-system@@ -132,5 +132,5 @@ test-framework, test-framework-hunit, HUnit,- shelly >= 0.15.4.1 && < 1.0,+ shelly >= 1.0, text
src/C2HS/CHS.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE StandaloneDeriving #-} -- C->Haskell Compiler: CHS file abstraction -- -- Author : Manuel M T Chakravarty@@ -126,6 +127,15 @@ -- data CHSModule = CHSModule [CHSFrag] +deriving instance Show CHSModule+deriving instance Show CHSFrag+deriving instance Show CHSHook+deriving instance Show CHSAccess+deriving instance Show CHSParm+deriving instance Show CHSTrans+deriving instance Show CHSArg+deriving instance Show CHSChangeCase+ -- | a CHS code fragament -- -- * 'CHSVerb' fragments are present throughout the compilation and finally@@ -144,6 +154,7 @@ data CHSFrag = CHSVerb String -- Haskell code Position | CHSHook CHSHook -- binding hook+ Position | CHSCPP String -- pre-processor directive Position Bool@@ -156,7 +167,7 @@ instance Pos CHSFrag where posOf (CHSVerb _ pos ) = pos- posOf (CHSHook hook ) = posOf hook+ posOf (CHSHook _ pos ) = pos posOf (CHSCPP _ pos _) = pos posOf (CHSLine pos ) = pos posOf (CHSC _ pos ) = pos@@ -458,7 +469,7 @@ else id) . showString s . showFrags pureHs nextState frags- showFrags False _ (CHSHook hook : frags) =+ showFrags False _ (CHSHook hook _ : frags) = showString "{#" . showCHSHook hook . showString "#}"@@ -810,19 +821,32 @@ frags <- parseFrags toks return $ CHSLine pos : frags parseFrags0 (CHSTokC pos s:toks) = parseC pos s toks- parseFrags0 (CHSTokImport pos :toks) = parseImport pos toks- parseFrags0 (CHSTokContext pos :toks) = parseContext pos toks- parseFrags0 (CHSTokType pos :toks) = parseType pos toks- parseFrags0 (CHSTokSizeof pos :toks) = parseSizeof pos toks- parseFrags0 (CHSTokAlignof pos :toks) = parseAlignof pos toks- parseFrags0 (CHSTokEnum pos :toks) = parseEnum pos toks- parseFrags0 (CHSTokCall pos :toks) = parseCall pos toks- parseFrags0 (CHSTokFun pos :toks) = parseFun pos toks- parseFrags0 (CHSTokGet pos :toks) = parseField pos CHSGet toks- parseFrags0 (CHSTokSet pos :toks) = parseField pos CHSSet toks- parseFrags0 (CHSTokOffsetof pos :toks) = parseOffsetof pos toks- parseFrags0 (CHSTokClass pos :toks) = parseClass pos toks- parseFrags0 (CHSTokPointer pos :toks) = parsePointer pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokImport pos :toks) = parseImport hkpos pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokContext pos :toks) = parseContext hkpos pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokType pos :toks) = parseType hkpos pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokSizeof pos :toks) = parseSizeof hkpos pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokAlignof pos :toks) = parseAlignof hkpos pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokEnum pos :toks) = parseEnum hkpos pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokCall pos :toks) = parseCall hkpos pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokFun pos :toks) = parseFun hkpos pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokGet pos :toks) = parseField hkpos pos CHSGet toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokSet pos :toks) = parseField hkpos pos CHSSet toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokOffsetof pos :toks) = parseOffsetof hkpos pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokClass pos :toks) = parseClass hkpos pos toks+ parseFrags0 (CHSTokHook hkpos:+ CHSTokPointer pos :toks) = parsePointer hkpos pos toks parseFrags0 toks = syntaxError toks -- -- skip to next Haskell or control token@@ -846,8 +870,8 @@ return $ CHSC s' pos' : frags collectCtrlAndC toks' = parseFrags toks' -parseImport :: Position -> [CHSToken] -> CST s [CHSFrag]-parseImport pos toks = do+parseImport :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]+parseImport hkpos pos toks = do (qual, modid, toks') <- case toks of CHSTokIdent _ ide :toks' ->@@ -860,7 +884,7 @@ chi <- loadCHI . moduleNameToFileName . identToString $ modid toks'2 <- parseEndHook toks' frags <- parseFrags toks'2- return $ CHSHook (CHSImport qual modid chi pos) : frags+ return $ CHSHook (CHSImport qual modid chi pos) hkpos : frags -- | Qualified module names do not get lexed as a single token so we need to -- reconstruct it from a sequence of identifer and dot tokens.@@ -878,54 +902,54 @@ where dotToSlash '.' = '/' dotToSlash c = c -parseContext :: Position -> [CHSToken] -> CST s [CHSFrag]-parseContext pos toks = do+parseContext :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]+parseContext hkpos pos toks = do (olib , toks2) <- parseOptLib toks (opref , toks3) <- parseOptPrefix False toks2 (oreppref, toks4) <- parseOptReplPrefix toks3 toks5 <- parseEndHook toks4 frags <- parseFrags toks5 let frag = CHSContext olib opref oreppref pos- return $ CHSHook frag : frags+ return $ CHSHook frag hkpos : frags -parseType :: Position -> [CHSToken] -> CST s [CHSFrag]-parseType pos (CHSTokIdent _ ide:toks) =+parseType :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]+parseType hkpos pos (CHSTokIdent _ ide:toks) = do toks' <- parseEndHook toks frags <- parseFrags toks'- return $ CHSHook (CHSType ide pos) : frags-parseType _ toks = syntaxError toks+ return $ CHSHook (CHSType ide pos) hkpos : frags+parseType _ _ toks = syntaxError toks -parseSizeof :: Position -> [CHSToken] -> CST s [CHSFrag]-parseSizeof pos (CHSTokIdent _ ide:toks) =+parseSizeof :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]+parseSizeof hkpos pos (CHSTokIdent _ ide:toks) = do toks' <- parseEndHook toks frags <- parseFrags toks'- return $ CHSHook (CHSSizeof ide pos) : frags-parseSizeof _ toks = syntaxError toks+ return $ CHSHook (CHSSizeof ide pos) hkpos : frags+parseSizeof _ _ toks = syntaxError toks -parseAlignof :: Position -> [CHSToken] -> CST s [CHSFrag]-parseAlignof pos (CHSTokIdent _ ide:toks) =+parseAlignof :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]+parseAlignof hkpos pos (CHSTokIdent _ ide:toks) = do toks' <- parseEndHook toks frags <- parseFrags toks'- return $ CHSHook (CHSAlignof ide pos) : frags-parseAlignof _ toks = syntaxError toks+ return $ CHSHook (CHSAlignof ide pos) hkpos : frags+parseAlignof _ _ toks = syntaxError toks -parseEnum :: Position -> [CHSToken] -> CST s [CHSFrag]+parseEnum :: Position -> Position -> [CHSToken] -> CST s [CHSFrag] -- {#enum define hsid {alias_1,...,alias_n} [deriving (clid_1,...,clid_n)] #}-parseEnum pos (CHSTokIdent _ def: CHSTokIdent _ hsid: toks)+parseEnum hkpos pos (CHSTokIdent _ def: CHSTokIdent _ hsid: toks) | identToString def == "define" = do (trans , toks') <- parseTrans toks (derive, toks'') <- parseDerive toks' toks''' <- parseEndHook toks'' frags <- parseFrags toks'''- return $ CHSHook (CHSEnumDefine hsid trans derive pos) : frags+ return $ CHSHook (CHSEnumDefine hsid trans derive pos) hkpos : frags -- {#enum cid [as hsid] {alias_1,...,alias_n} [with prefix = pref] [deriving (clid_1,...,clid_n)] #}-parseEnum pos (CHSTokIdent _ ide:toks) =+parseEnum hkpos pos (CHSTokIdent _ ide:toks) = do (oalias, toks2) <- parseOptAs ide True toks (trans, toks3) <- parseTrans toks2@@ -935,15 +959,15 @@ toks7 <- parseEndHook toks6 frags <- parseFrags toks7 return $ CHSHook (CHSEnum ide (norm oalias) trans- oprefix oreplprefix derive pos) : frags+ oprefix oreplprefix derive pos) hkpos : frags where norm Nothing = Nothing norm (Just ide') | ide == ide' = Nothing | otherwise = Just ide'-parseEnum _ toks = syntaxError toks+parseEnum _ _ toks = syntaxError toks -parseCall :: Position -> [CHSToken] -> CST s [CHSFrag]-parseCall pos toks =+parseCall :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]+parseCall hkpos pos toks = do (isPure , toks' ) <- parseIsPure toks (isUnsafe, toks'' ) <- parseIsUnsafe toks'@@ -952,10 +976,10 @@ toks''''' <- parseEndHook toks'''' frags <- parseFrags toks''''' return $- CHSHook (CHSCall isPure isUnsafe apath oalias pos) : frags+ CHSHook (CHSCall isPure isUnsafe apath oalias pos) hkpos : frags -parseFun :: Position -> [CHSToken] -> CST s [CHSFrag]-parseFun pos toks =+parseFun :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]+parseFun hkpos pos toks = do (isPure , toks' ) <- parseIsPure toks (isUnsafe, toks'2) <- parseIsUnsafe toks'@@ -968,7 +992,7 @@ frags <- parseFrags toks'8 return $ CHSHook- (CHSFun isPure isUnsafe apath oalias octxt parms parm pos) :+ (CHSFun isPure isUnsafe apath oalias octxt parms parm pos) hkpos : frags where parseOptContext (CHSTokHSVerb _ ctxt:CHSTokDArrow _:toks') =@@ -1050,24 +1074,24 @@ parseOptMarshType toks' = return (CHSValArg, toks') -parseField :: Position -> CHSAccess -> [CHSToken] -> CST s [CHSFrag]-parseField pos access toks =+parseField :: Position -> Position -> CHSAccess -> [CHSToken] -> CST s [CHSFrag]+parseField hkpos pos access toks = do (path, toks') <- parsePath toks toks'' <- parseEndHook toks' frags <- parseFrags toks''- return $ CHSHook (CHSField access path pos) : frags+ return $ CHSHook (CHSField access path pos) hkpos : frags -parseOffsetof :: Position -> [CHSToken] -> CST s [CHSFrag]-parseOffsetof pos toks =+parseOffsetof :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]+parseOffsetof hkpos pos toks = do (path, toks') <- parsePath toks toks'' <- parseEndHook toks' frags <- parseFrags toks''- return $ CHSHook (CHSOffsetof path pos) : frags+ return $ CHSHook (CHSOffsetof path pos) hkpos : frags -parsePointer :: Position -> [CHSToken] -> CST s [CHSFrag]-parsePointer pos toks =+parsePointer :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]+parsePointer hkpos pos toks = do (isStar, ide, toks') <- case toks of@@ -1092,7 +1116,7 @@ return $ CHSHook (CHSPointer- isStar ide (norm ide oalias) ptrType isNewtype oRefType emit pos)+ isStar ide (norm ide oalias) ptrType isNewtype oRefType emit pos) hkpos : frags where parsePtrType :: [CHSToken] -> CST s (CHSPtrType, [CHSToken])@@ -1104,8 +1128,8 @@ norm ide (Just ide') | ide == ide' = Nothing | otherwise = Just ide' -parseClass :: Position -> [CHSToken] -> CST s [CHSFrag]-parseClass pos (CHSTokIdent _ sclassIde:+parseClass :: Position -> Position -> [CHSToken] -> CST s [CHSFrag]+parseClass hkpos pos (CHSTokIdent _ sclassIde: CHSTokDArrow _ : CHSTokIdent _ classIde : CHSTokIdent _ typeIde :@@ -1113,15 +1137,16 @@ do toks' <- parseEndHook toks frags <- parseFrags toks'- return $ CHSHook (CHSClass (Just sclassIde) classIde typeIde pos) : frags-parseClass pos (CHSTokIdent _ classIde :- CHSTokIdent _ typeIde :- toks) =+ return $ CHSHook (CHSClass (Just sclassIde)+ classIde typeIde pos) hkpos : frags+parseClass hkpos pos (CHSTokIdent _ classIde :+ CHSTokIdent _ typeIde :+ toks) = do toks' <- parseEndHook toks frags <- parseFrags toks'- return $ CHSHook (CHSClass Nothing classIde typeIde pos) : frags-parseClass _ toks = syntaxError toks+ return $ CHSHook (CHSClass Nothing classIde typeIde pos) hkpos : frags+parseClass _ _ toks = syntaxError toks parseOptLib :: [CHSToken] -> CST s (Maybe String, [CHSToken]) parseOptLib (CHSTokLib _ :
src/C2HS/CHS/Lexer.hs view
@@ -204,6 +204,7 @@ | CHSTokRBrace Position -- `}' | CHSTokLParen Position -- `(' | CHSTokRParen Position -- `)'+ | CHSTokHook Position -- `{#' | CHSTokEndHook Position -- `#}' | CHSTokAdd Position -- `add' | CHSTokAs Position -- `as'@@ -599,7 +600,8 @@ -- hook :: CHSLexer hook = string "{#"- `lexmeta` \_ pos s -> (Nothing, incPos pos 2, s, Just bhLexer)+ `lexmeta` \_ pos s -> (Just $ Right (CHSTokHook pos),+ incPos pos 2, s, Just bhLexer) -- | start marker: used to identify pre-processor directive at -- beginning of input -- this lexer just drops the start marker if it
src/C2HS/Gen/Bind.hs view
@@ -362,9 +362,9 @@ expandFrag :: CHSFrag -> GB [CHSFrag] expandFrag verb@(CHSVerb _ _ ) = return [verb] expandFrag line@(CHSLine _ ) = return [line]-expandFrag (CHSHook h ) =+expandFrag (CHSHook h pos) = do- code <- expandHook h+ code <- expandHook h pos return [CHSVerb code builtinPos] `ifCTExc` return [CHSVerb "** ERROR **" builtinPos] expandFrag (CHSCPP s _ _) =@@ -398,20 +398,20 @@ else traceGenBind "Choosing else branch.\n" -expandHook :: CHSHook -> GB String-expandHook (CHSImport qual ide chi _) =+expandHook :: CHSHook -> Position -> GB String+expandHook (CHSImport qual ide chi _) _ = do mergeMaps chi return $ "import " ++ (if qual then "qualified " else "") ++ identToString ide-expandHook (CHSContext olib oprefix orepprefix _) =+expandHook (CHSContext olib oprefix orepprefix _) _ = do setContext olib oprefix orepprefix -- enter context information -- use the prefix on name spaces when (isJust oprefix) $ applyPrefixToNameSpaces (fromJust oprefix) (maybe "" id orepprefix) return ""-expandHook (CHSType ide pos) =+expandHook (CHSType ide pos) _ = do traceInfoType decl <- findAndChaseDecl ide False True -- no indirection, but shadows@@ -424,7 +424,7 @@ traceInfoDump decl ty = traceGenBind $ "Declaration\n" ++ show decl ++ "\ntranslates to\n" ++ showExtType ty ++ "\n"-expandHook (CHSAlignof ide _) =+expandHook (CHSAlignof ide _) _ = do traceInfoAlignof decl <- findAndChaseDecl ide False True -- no indirection, but shadows@@ -437,7 +437,7 @@ "Alignment of declaration\n" ++ show decl ++ "\nis " ++ show align ++ "\n" -expandHook (CHSSizeof ide _) =+expandHook (CHSSizeof ide _) _ = do traceInfoSizeof decl <- findAndChaseDecl ide False True -- no indirection, but shadows@@ -449,9 +449,9 @@ traceInfoDump decl size = traceGenBind $ "Size of declaration\n" ++ show decl ++ "\nis " ++ show (padBits size) ++ "\n"-expandHook (CHSEnumDefine _ _ _ _) =+expandHook (CHSEnumDefine _ _ _ _) _ = interr "Binding generation error : enum define hooks should be eliminated via preprocessing "-expandHook (CHSEnum cide oalias chsTrans oprefix orepprefix derive pos) =+expandHook (CHSEnum cide oalias chsTrans oprefix orepprefix derive pos) _ = do -- get the corresponding C declaration --@@ -471,7 +471,7 @@ let trans = transTabToTransFun pfx reppfx chsTrans hide = identToString . fromMaybe cide $ oalias enumDef enum hide trans (map identToString derive) pos-expandHook hook@(CHSCall isPure isUns (CHSRoot _ ide) oalias pos) =+expandHook hook@(CHSCall isPure isUns (CHSRoot _ ide) oalias pos) _ = do traceEnter -- get the corresponding C declaration; raises error if not found or not a@@ -487,7 +487,7 @@ where traceEnter = traceGenBind $ "** Call hook for `" ++ identToString ide ++ "':\n"-expandHook hook@(CHSCall isPure isUns apath oalias pos) =+expandHook hook@(CHSCall isPure isUns apath oalias pos) _ = do traceEnter @@ -518,9 +518,11 @@ "** Indirect call hook for `" ++ identToString (apathToIdent apath) ++ "':\n" traceValueType et = traceGenBind $ "Type of accessed value: " ++ showExtType et ++ "\n"-expandHook (CHSFun isPure isUns (CHSRoot _ ide) oalias ctxt parms parm pos) =+expandHook (CHSFun isPure isUns (CHSRoot _ ide)+ oalias ctxt parms parm pos) hkpos = do traceEnter+ traceGenBind $ "ide = '" ++ show ide ++ "'\n" -- get the corresponding C declaration; raises error if not found or not a -- function; we use shadow identifiers, so the returned identifier is used -- afterwards instead of the original one@@ -535,11 +537,11 @@ callImport callHook isPure isUns (identToString cide) fiLexeme cdecl' pos extTy <- extractFunType pos cdecl' True- funDef isPure hsLexeme fiLexeme extTy ctxt parms parm Nothing pos+ funDef isPure hsLexeme fiLexeme extTy ctxt parms parm Nothing pos hkpos where traceEnter = traceGenBind $ "** Fun hook for `" ++ identToString ide ++ "':\n"-expandHook (CHSFun isPure isUns apath oalias ctxt parms parm pos) =+expandHook (CHSFun isPure isUns apath oalias ctxt parms parm pos) hkpos = do traceEnter @@ -567,7 +569,7 @@ set_get <- setGet pos CHSGet offsets ptrTy funDef isPure hsLexeme fiLexeme (FunET ptrTy $ purify ty)- ctxt parms parm (Just set_get) pos+ ctxt parms parm (Just set_get) pos hkpos where -- remove IO from the result type of a function ExtType. necessary -- due to an unexpected interaction with the way funDef works@@ -579,7 +581,7 @@ "** Fun hook for `" ++ identToString (apathToIdent apath) ++ "':\n" traceValueType et = traceGenBind $ "Type of accessed value: " ++ showExtType et ++ "\n"-expandHook (CHSField access path pos) =+expandHook (CHSField access path pos) _ = do traceInfoField traceGenBind $ "path = " ++ show path ++ "\n"@@ -597,7 +599,7 @@ ++ show (length offsets) ++ "\n" traceValueType et = traceGenBind $ "Type of accessed value: " ++ showExtType et ++ "\n"-expandHook (CHSOffsetof path pos) =+expandHook (CHSOffsetof path pos) _ = do traceGenBind $ "** offsetof hook:\n" (decl, offsets) <- accessPath path@@ -620,7 +622,7 @@ SUType _ -> return offset checkType _ _ = offsetDerefErr pos expandHook (CHSPointer isStar cName oalias ptrKind isNewtype oRefType emit- pos) =+ pos) _ = do traceInfoPointer let hsIde = fromMaybe cName oalias@@ -686,7 +688,7 @@ ++ "\n" traceInfoCName kind ide = traceGenBind $ "found C " ++ kind ++ " for `" ++ identToString ide ++ "'\n"-expandHook (CHSClass oclassIde classIde typeIde pos) =+expandHook (CHSClass oclassIde classIde typeIde pos) _ = do traceInfoClass classIde `objIs` Class oclassIde typeIde -- register Haskell object@@ -905,8 +907,9 @@ -> CHSParm -- result marshalling description -> Maybe String -- optional additional marshaller for first arg -> Position -- source location of the hook+ -> Position -- source location of the start of the hook -> GB String -- Haskell code in text form-funDef isPure hsLexeme fiLexeme extTy octxt parms parm marsh2 pos =+funDef isPure hsLexeme fiLexeme extTy octxt parms parm marsh2 pos hkpos = do (parms', parm', isImpure) <- addDftMarshaller pos parms parm extTy @@ -961,8 +964,7 @@ " " ++ (if isImpure || not isPure then "return " else "") ++ ret - pad code = let col = posColumn pos- padding = replicate (col - 3) ' '+ pad code = let padding = replicate (posColumn hkpos - 1) ' ' (l:ls) = lines code in unlines $ l : map (padding ++) ls
src/C2HS/Gen/Header.hs view
@@ -168,7 +168,7 @@ -- generate an enum __c2hs__enum__'id { __c2hs_enr__'id = DEF1, ... } and then process an -- ordinary enum directive-ghFrag (_frag@(CHSHook (CHSEnumDefine hsident trans instances pos)) : frags) =+ghFrag (_frag@(CHSHook (CHSEnumDefine hsident trans instances pos) hkpos) : frags) = do ide <- newEnumIdent (enrs,trans') <- createEnumerators trans return (DL.open [show.pretty $ enumDef ide enrs,";\n"], Frag (enumFrag (identToString ide) trans'), frags)@@ -184,9 +184,9 @@ createEnumerator (cid,hsid) = liftM (\enr -> ((enr,cid),(enr,hsid))) newEnrIdent enumDef ide enrs = CEnum (Just ide) (Just$ map mkEnr enrs) [] undefNode where mkEnr (name,value) = (name, Just $ CVar value undefNode)- enumFrag ide trans' = CHSHook (CHSEnum (internalIdent ide) (Just hsident) trans' Nothing Nothing instances pos)+ enumFrag ide trans' = CHSHook (CHSEnum (internalIdent ide) (Just hsident) trans' Nothing Nothing instances pos) hkpos -ghFrag (frag@(CHSHook _ ) : frags) =+ghFrag (frag@(CHSHook _ _) : frags) = return (DL.zero, Frag frag, frags) ghFrag (frag@(CHSLine _ ) : frags) = return (DL.zero, Frag frag, frags)@@ -251,7 +251,7 @@ _ -> interr "GenHeader.ghFrag: Expected CHSCond!" Endif _ -> closeIf (headerTh `DL.snoc` "#endif\n")- (s, fragsTh)+ (s', fragsTh) [] (Just []) rest
tests/test-bugs.hs view
@@ -6,10 +6,10 @@ import Test.HUnit hiding (Test, assert) import System.FilePath (searchPathSeparator) import Shelly-import Data.Text.Lazy (Text)+import Data.Text (Text) import Data.Monoid-import qualified Data.Text.Lazy as LT-default (LT.Text)+import qualified Data.Text as T+default (T.Text) main :: IO () main = defaultMain tests@@ -18,6 +18,7 @@ tests = [ testGroup "Bugs" [ testCase "call_capital (issue #??)" call_capital+ , testCase "Issue #69" issue69 , testCase "Issue #60" issue60 , testCase "Issue #51" issue51 , testCase "Issue #47" issue47@@ -48,8 +49,11 @@ cmd "ghc" "--make" "-cpp" "Capital_c.o" "Capital.hs" res <- absPath "./Capital" >>= cmd let expected = ["upper C();", "lower c();", "upper C();"]- liftIO $ assertBool "" (LT.lines res == expected)+ liftIO $ assertBool "" (T.lines res == expected) +issue69 :: Assertion+issue69 = build_issue 69+ issue60 :: Assertion issue60 = build_issue 60 @@ -110,7 +114,7 @@ "Issue30Aux1.hs" "Issue30Aux2.hs" "Issue30.hs" res <- absPath "./Issue30" >>= cmd let expected = ["3", "2", "4"]- liftIO $ assertBool "" (LT.lines res == expected)+ liftIO $ assertBool "" (T.lines res == expected) issue29 :: Assertion issue29 = shelly $ do@@ -151,7 +155,7 @@ let wdir = "tests/bugs" </> ("issue-" <> show n) lc = "issue" <> show n lcc = lc <> "_c"- uc = fromText $ LT.pack $ "Issue" <> show n+ uc = fromText $ T.pack $ "Issue" <> show n in do cd wdir mapM_ rm_f [uc <.> "hs", uc <.> "chs.h", uc <.> "chi", lcc <.> "o", uc]@@ -165,8 +169,8 @@ expect_issue_with :: Int -> [Text] -> [Text] -> Assertion expect_issue_with n c2hsargs expected = shelly $ do do_issue_build n c2hsargs- res <- absPath ("." </> (fromText $ LT.pack $ "Issue" <> show n)) >>= cmd- liftIO $ assertBool "" (LT.lines res == expected)+ res <- absPath ("." </> (fromText $ T.pack $ "Issue" <> show n)) >>= cmd+ liftIO $ assertBool "" (T.lines res == expected) build_issue_with :: Int -> [Text] -> Assertion build_issue_with n c2hsargs = shelly $ do
tests/test-system.hs view
@@ -7,9 +7,9 @@ import Shelly import qualified Shelly as Sh import Control.Monad (forM_)-import Data.Text.Lazy (Text)-import qualified Data.Text.Lazy as LT-default (LT.Text)+import Data.Text (Text)+import qualified Data.Text as T+default (T.Text) main :: IO () main = defaultMain tests@@ -40,7 +40,7 @@ run_test_expect dir cmds expcmd expected = shelly $ chdir dir $ do forM_ cmds $ \(c, as) -> run c as res <- absPath expcmd >>= cmd- liftIO $ assertBool "" (LT.lines res == expected)+ liftIO $ assertBool "" (T.lines res == expected) test_calls :: Assertion