c2hs 0.27.1 → 0.28.1

raw patch · 12 files changed

+76/−17 lines, 12 filesdep ~language-c

Dependency ranges changed: language-c

Files

• ChangeLog +4/−0
• c2hs.cabal +3/−2
• src/C2HS/Gen/Bind.hs +8/−6
• src/C2HS/Gen/Monad.hs +2/−2
• src/C2HS/Version.hs +2/−2
• tests/bugs/issue-10/Issue10.chs +12/−4
• tests/bugs/issue-10/issue10.c +1/−0
• tests/bugs/issue-10/issue10.h +6/−0
• tests/bugs/issue-155/Issue155.chs +6/−0
• tests/bugs/issue-155/Types.chs +12/−0
• tests/bugs/issue-155/types.h +7/−0
• tests/test-bugs.hs +13/−1

@@ -1,3 +1,7 @@+0.28.1+ - Switch to language-c 0.5 [#157]+ - Fix class hook problem with imports [#155]+ 0.27.1  - Alternate specification for sizes in "+" parameters [#140]  - Fix regression to do with incomplete structure types [#152]

@@ -1,5 +1,5 @@ Name:           c2hs-Version:        0.27.1+Version:        0.28.1 License:        GPL-2 License-File:   COPYING Copyright:      Copyright (c) 1999-2007 Manuel M T Chakravarty@@ -100,6 +100,7 @@   tests/bugs/issue-149/*.chs tests/bugs/issue-149/*.h tests/bugs/issue-149/*.c   tests/bugs/issue-151/*.chs tests/bugs/issue-151/*.h   tests/bugs/issue-152/*.chs tests/bugs/issue-152/*.h+  tests/bugs/issue-155/*.chs tests/bugs/issue-155/*.h  source-repository head   type:         git@@ -110,7 +111,7 @@ Executable c2hs     Build-Depends:  base >= 2 && < 5,                     bytestring,-                    language-c >= 0.4.7 && < 0.5,+                    language-c >= 0.5 && < 0.6,                     filepath,                     dlist 

@@ -903,7 +903,8 @@ expandHook (CHSClass oclassIde classIde typeIde pos) _ =   do     traceInfoClass-    classIde `objIs` Class oclassIde typeIde    -- register Haskell object+    classIde `objIs` Class (fmap identToString oclassIde)+      (identToString typeIde)    -- register Haskell object     superClasses <- collectClasses oclassIde     Pointer ptrType isNewtype <- queryPointer typeIde     when (ptrType == CHSStablePtr) $@@ -918,9 +919,9 @@     collectClasses (Just ide)  =       do         Class oclassIde' typeIde' <- queryClass ide-        ptr                       <- queryPointer typeIde'-        classes                   <- collectClasses oclassIde'-        return $ (identToString ide, identToString typeIde', ptr) : classes+        ptr                       <- queryPointer (internalIdent typeIde')+        classes                   <- collectClasses (fmap internalIdent oclassIde')+        return $ (identToString ide, typeIde', ptr) : classes     --     traceInfoClass = traceGenBind $ "** Class hook:\n" expandHook (CHSConst cIde _) _ =@@ -1821,7 +1822,7 @@               ""   -> errorAtPos pos ["GenBind.classDef: Illegal identifier - 2!"]               c:cs -> toLower c : cs             fromMethodName  = "from" ++ ptrName-            castFun         = "cast" ++ show ptrType+            castFun         = impm $ "cast" ++ show ptrType             typeConstr      = if isNewtype  then typeName ++ " " else ""             superConstr     = if isNewtype' then ptrName  ++ " " else ""             instDef         =@@ -1830,6 +1831,7 @@                 ++ superConstr ++ "(" ++ castFun ++ " p)\n"               ++ "  " ++ fromMethodName   ++ " (" ++ superConstr ++ "p) = "                 ++ typeConstr  ++ "(" ++ castFun ++ " p)\n"+        addHsDependency "Foreign.Ptr"         instDefs <- castInstDefs classes         return $ instDef ++ instDefs @@ -2418,7 +2420,7 @@   do     (sz, align) <- sizeAlignOfStruct decls tag     let b = size CIntPT-    return (alignOffset sz b b, align)+    return (alignOffset sz (align `max` b) b, align)  -- | compute the size and alignment constraint of a given C declaration --

@@ -216,8 +216,8 @@                      isNewtypeHO  :: Bool          -- newtype?                    }                  | Class {-                     superclassHO :: (Maybe Ident),-- superclass-                     ptrHO        :: Ident         -- pointer+                     superclassHO :: (Maybe String),-- superclass+                     ptrHO        :: String         -- pointer                    }                  deriving (Show, Read) type HsObjectMap = Map Ident HsObject

@@ -9,8 +9,8 @@  name       = "C->Haskell Compiler" versnum    = Paths_c2hs.version-versnick   = "Eternal Sunshine"-date       = "29 November 2015"+versnick   = "Switcheroo"+date       = "1 April 2016" version    = name ++ ", version " ++ showVersion versnum ++ " " ++ versnick ++ ", " ++ date copyright  = "Copyright (c) 1999-2007 Manuel M T Chakravarty\n"           ++ "              2005-2008 Duncan Coutts\n"

@@ -4,6 +4,11 @@  #include "issue10.h" +check :: Int -> Int -> IO ()+check sz szexpect =+  putStrLn $ if sz == szexpect then "SAME"+             else ("DIFF: " ++ show sz ++ " vs. " ++ show szexpect)+ main :: IO () main = do   let sz1 = {# sizeof S1 #} :: Int@@ -14,7 +19,10 @@   sz3expect <- liftM fromIntegral {# call size_of_s3 #} :: IO Int   let sz4 = {# sizeof S4 #} :: Int   sz4expect <- liftM fromIntegral {# call size_of_s4 #} :: IO Int-  putStrLn $ if sz1 == sz1expect then "SAME" else "DIFF"-  putStrLn $ if sz2 == sz2expect then "SAME" else "DIFF"-  putStrLn $ if sz3 == sz3expect then "SAME" else "DIFF"-  putStrLn $ if sz4 == sz4expect then "SAME" else "DIFF"+  let sz5 = {# sizeof S5 #} :: Int+  sz5expect <- liftM fromIntegral {# call size_of_s5 #} :: IO Int+  check sz1 sz1expect+  check sz2 sz2expect+  check sz3 sz3expect+  check sz4 sz4expect+  check sz5 sz5expect

@@ -4,3 +4,4 @@ size_t size_of_s2(void) { return sizeof(S2); } size_t size_of_s3(void) { return sizeof(S3); } size_t size_of_s4(void) { return sizeof(S4); }+size_t size_of_s5(void) { return sizeof(S5); }

@@ -4,6 +4,7 @@ size_t size_of_s2(void); size_t size_of_s3(void); size_t size_of_s4(void);+size_t size_of_s5(void);  typedef struct {   int f1:1;@@ -29,3 +30,8 @@   unsigned int b0: 31;   unsigned int b30: 1; } S4;++typedef struct {+  double d;+  char c;+} S5;

@@ -0,0 +1,6 @@+module Main where++{# import Types #}++main :: IO ()+main = putStrLn "OK"

@@ -0,0 +1,12 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+module Types where++#include "types.h"++data ExampleStruct+{# pointer *example_struct as ExampleStructPtr -> ExampleStruct #}+{# class ExampleStructClass ExampleStructPtr #}++data ChildStruct+{# pointer *child_struct as ChildStructPtr -> ChildStruct #}+{# class ExampleStructClass => ChildStructClass ChildStructPtr #}

@@ -0,0 +1,7 @@+typedef struct {+  int a;+} example_struct;++typedef struct {+  int b;+} child_struct;

@@ -91,6 +91,7 @@     , testCase "Issue #149" issue149     , testCase "Issue #151" issue151     , testCase "Issue #152" issue152+    , testCase "Issue #155" issue155     ] ++     -- Some tests that won't work on Windows.     if os /= "cygwin32" && os /= "mingw32"@@ -111,6 +112,17 @@   let expected = ["upper C();", "lower c();", "upper C();"]   liftIO $ assertBool "" (T.lines res == expected) +issue155 :: Assertion+issue155 = c2hsShelly $ chdir "tests/bugs/issue-155" $ do+  mapM_ rm_f ["Issue155.hs", "Issue155.chs.h", "Issue155.chs.c", "Issue155.chi",+              "Issue155.chs.o", "Issue155", "Types.chi", "Types.chs.h", "Types.hs"]+  cmd "c2hs" "Types.chs"+  cmd "c2hs" "Issue155.chs"+  cmd "ghc" "--make" "Issue155.hs"+  res <- absPath "./Issue155" >>= cmd+  let expected = ["OK"]+  liftIO $ assertBool "" (T.lines res == expected)+ issue152 :: Assertion issue152 = hs_only_build_issue 152 @@ -396,7 +408,7 @@ issue15 = expect_issue 15 ["True"]  issue10 :: Assertion-issue10 = expect_issue 10 ["SAME", "SAME", "SAME", "SAME"]+issue10 = expect_issue 10 ["SAME", "SAME", "SAME", "SAME", "SAME"]  issue09 :: Assertion issue09 = expect_issue 9 $ archdep ++ ["(32,64)", "64", "OK"]