packages feed

c2hs 0.26.1 → 0.26.2

raw patch · 14 files changed

+135/−21 lines, 14 files

Files

c2hs.cabal view
@@ -1,5 +1,5 @@ Name:           c2hs-Version:        0.26.1+Version:        0.26.2 License:        GPL-2 License-File:   COPYING Copyright:      Copyright (c) 1999-2007 Manuel M T Chakravarty@@ -95,6 +95,9 @@   tests/bugs/issue-133/*.chs tests/bugs/issue-133/*.h   tests/bugs/issue-134/*.chs tests/bugs/issue-134/*.h   tests/bugs/issue-136/*.chs tests/bugs/issue-136/*.h tests/bugs/issue-136/*.c+  tests/bugs/issue-141/*.chs tests/bugs/issue-141/*.h+  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  source-repository head   type:         git
src/C2HS/C/Trav.hs view
@@ -880,7 +880,8 @@                                     traceCTrav $ "def=" ++ show def ++ "\n"                                     case def of                                       TagCD tag -> extractStruct pos tag-                                      bad_obj       -> err ide' bad_obj+                                      UndefCD   -> incompleteTypeErr pos+                                      bad_obj   -> err ide' bad_obj     _                          -> return su   where     err ide bad_obj =@@ -970,3 +971,9 @@   raiseErrorCTExc pos     ["Expected a struct!",      "Expected a structure or union; instead found an enum or basic type."]++incompleteTypeErr     :: Position -> CT s a+incompleteTypeErr pos  =+  raiseErrorCTExc pos+    ["Illegal use of incomplete type!",+     "Expected a fully defined structure or union tag; instead found incomplete type."]
src/C2HS/Gen/Bind.hs view
@@ -164,7 +164,6 @@                    queryDefaultMarsh, isDefaultMarsh, addWrapper, getWrappers,                    addHsDependency, getHsDependencies) - -- Module import alias. imp :: String imp = "C2HSImp"@@ -604,6 +603,7 @@   do     traceInfoAlignof     decl <- findAndChaseDeclOrTag ide False True  -- no indirection, but shadows+    checkForIncomplete decl     (_, align) <- sizeAlignOf decl     traceInfoDump (render $ pretty decl) align     return $ show align@@ -617,6 +617,7 @@   do     traceInfoSizeof     decl <- findAndChaseDeclOrTag ide False True  -- no indirection, but shadows+    checkForIncomplete decl     (sz, _) <- sizeAlignOf decl     traceInfoDump (render $ pretty decl) sz     return $ show (padBits sz)@@ -857,6 +858,7 @@                              let et' = adjustPtr isStar et                              when (isVariadic et')                                   (variadicErr pos (posOf cDecl))+                             addExtTypeDependency et'                              return (showExtType et', isFunExtType et')             hsType -> return (identsToString hsType, False)             -- FIXME: it is not possible to determine whether `hsType'@@ -1696,7 +1698,6 @@            -> Bool              -- shall we emit code?            -> GB String pointerDef isStar cNameFull hsName ptrKind isNewtype hsType isFun emit =-  -- ====> NEED TO DO DEPENDENCIES HERE!   do     let ptrArg  = if isNewtype                   then hsName           -- abstract type@@ -2003,7 +2004,7 @@     -- function)     --     let wrap = case wrapped of-          Just w  -> w+          Just w  -> w ++ repeat False           Nothing -> repeat False     argTypes <- zipWithM (extractCompType False True) wrap args     return $ foldr FunET resultType argTypes@@ -2462,6 +2463,14 @@       "extractCompType: found an alias called `" ++ identToString ide ++ "'\n"  +checkForIncomplete :: CDecl -> GB ()+checkForIncomplete cdecl = do+  ct <- extractCompType False False False cdecl+  case ct of+    SUET (CStruct _ _ Nothing _ _) -> incompleteTypeErr $ posOf cdecl+    _                              -> return ()++ sizeAlignOfSingle ptr cdecl = do   ct <- extractCompType False False False cdecl   case ct of@@ -2896,6 +2905,12 @@  undefEnumErr :: Position -> GB a undefEnumErr pos = raiseErrorCTExc pos ["Incomplete enum type!"]++incompleteTypeErr     :: Position -> GB a+incompleteTypeErr pos  =+  raiseErrorCTExc pos+    ["Illegal use of incomplete type!",+     "Expected a fully defined structure or union tag; instead found incomplete type."]   -- | size of primitive type of C
src/C2HS/Version.hs view
@@ -10,7 +10,7 @@ name       = "C->Haskell Compiler" versnum    = Paths_c2hs.version versnick   = "Budburst"-date       = "4 April 2015"+date       = "26 October 2015" version    = name ++ ", version " ++ showVersion versnum ++ " " ++ versnick ++ ", " ++ date copyright  = "Copyright (c) 1999-2007 Manuel M T Chakravarty\n"           ++ "              2005-2008 Duncan Coutts\n"
+ tests/bugs/issue-141/Issue141A.chs view
@@ -0,0 +1,8 @@+module Main where++#include "issue141.h"++main :: IO ()+main = do+  print {#sizeof _p_Vec#}+  print "OK"
+ tests/bugs/issue-141/Issue141B.chs view
@@ -0,0 +1,8 @@+module Main where++#include "issue141.h"++main :: IO ()+main = do+  print {#alignof _p_Vec#}+  print "OK"
+ tests/bugs/issue-141/Issue141C.chs view
@@ -0,0 +1,8 @@+module Main where++#include "issue141.h"++main :: IO ()+main = do+  let f = {#get _p_Vec->fieldname#}+  print "OK"
+ tests/bugs/issue-141/issue141.h view
@@ -0,0 +1,1 @@+typedef struct _p_Vec *Vec;
+ tests/bugs/issue-149/Issue149.chs view
@@ -0,0 +1,10 @@+module Main where++#include "issue149.h"++{#fun unsafe test as ^ {} -> `()'#}++main :: IO ()+main = do+  test+  print "OK"
+ tests/bugs/issue-149/issue149.c view
@@ -0,0 +1,6 @@+#include <stdio.h>++void test(int arg)+{+  printf("test: %d\n", arg);+}
+ tests/bugs/issue-149/issue149.h view
@@ -0,0 +1,1 @@+void test(int arg);
+ tests/bugs/issue-151/Issue151.chs view
@@ -0,0 +1,10 @@+module Issue151 where++{# context lib = "gdal" prefix = "CPL" #}++#include "issue151.h"++{#pointer ErrorHandler#}++main :: IO ()+main = print "OK"
+ tests/bugs/issue-151/issue151.h view
@@ -0,0 +1,1 @@+typedef void (*CPLErrorHandler)(int, const char*);
tests/test-bugs.hs view
@@ -7,6 +7,7 @@ import System.FilePath (searchPathSeparator) import System.Info (os) import Prelude hiding (FilePath)+import Control.Monad (forM) import Control.Monad.IO.Class import Shelly import Data.List (sort)@@ -85,6 +86,9 @@     , testCase "Issue #133" issue133     , testCase "Issue #134" issue134     , testCase "Issue #136" issue136+    , testCase "Issue #141" issue141+    , testCase "Issue #149" issue149+    , testCase "Issue #151" issue151     ] ++     -- Some tests that won't work on Windows.     if os /= "cygwin32" && os /= "mingw32"@@ -105,6 +109,22 @@   let expected = ["upper C();", "lower c();", "upper C();"]   liftIO $ assertBool "" (T.lines res == expected) +issue151 :: Assertion+issue151 = hs_only_build_issue 151++issue149 :: Assertion+issue149 = build_issue_fails 149++issue141 :: Assertion+issue141 = c2hsShelly $ chdir "tests/bugs/issue-141" $ do+  mapM_ rm_f ["Issue141A.hs", "Issue141A.chs.h", "Issue141A.chi",+              "Issue141B.hs", "Issue141B.chs.h", "Issue141B.chi",+              "Issue141C.hs", "Issue141C.chs.h", "Issue141C.chi"]+  codes <- forM ["A", "B", "C"] $ \suff -> do+    errExit False $ cmd "c2hs" $ "Issue141" <> suff <> ".chs"+    lastExitCode+  liftIO $ assertBool "" (all (/= 0) codes)+ issue136 :: Assertion issue136 = build_issue_tolerant 136 @@ -386,27 +406,30 @@   code <- lastExitCode   liftIO $ assertBool "" (code == 0) -do_issue_build :: Bool -> Bool -> Int -> String -> [Text] -> Sh ()-do_issue_build strict cbuild n ext c2hsargs =+do_issue_build :: Bool -> Bool -> Int -> String -> String -> [Text] -> Sh ()+do_issue_build strict cbuild n suff ext c2hsargs =   let wdir = "tests/bugs" </> ("issue-" <> show n)       lc = "issue" <> show n       lcc = lc <> "_c"-      uc = fromText $ T.pack $ "Issue" <> show n <>+      uc = fromText $ T.pack $ "Issue" <> show n <> suff <>            (if ext == "" then "" else "_" <> ext)   in do     cd wdir     mapM_ rm_f [uc <.> "hs", uc <.> "chs.h", uc <.> "chi", lcc <.> "o", uc]     run "c2hs" $ c2hsargs ++ [toTextIgnore $ uc <.> "chs"]-    when cbuild $ cmd cc "-c" "-o" (lcc <.> "o") (lc <.> "c")-    case (strict, cbuild) of-      (True, True) ->-        cmd "ghc" "-Wall" "-Werror" "--make" (lcc <.> "o") (uc <.> "hs")-      (False, True) ->-        cmd "ghc" "--make" (lcc <.> "o") (uc <.> "hs")-      (True, False) ->-        cmd "ghc" "-Wall" "-Werror" "--make" (uc <.> "hs")-      (False, False) ->-        cmd "ghc" "--make" (uc <.> "hs")+    code <- lastExitCode+    when (code == 0) $ do+      when cbuild $ cmd cc "-c" "-o" (lcc <.> "o") (lc <.> "c")+      code <- lastExitCode+      when (code == 0) $ case (strict, cbuild) of+        (True, True) ->+          cmd "ghc" "-Wall" "-Werror" "--make" (lcc <.> "o") (uc <.> "hs")+        (False, True) ->+          cmd "ghc" "--make" (lcc <.> "o") (uc <.> "hs")+        (True, False) ->+          cmd "ghc" "-Wall" "-Werror" "--make" (uc <.> "hs")+        (False, False) ->+          cmd "ghc" "--make" (uc <.> "hs")  expect_issue :: Int -> [Text] -> Assertion expect_issue n expected = expect_issue_with True True n "" [] expected@@ -422,7 +445,7 @@ expect_issue_with :: Bool -> Bool -> Int -> String -> [Text] -> [Text]                   -> Assertion expect_issue_with ordered cbuild n ext c2hsargs expected = c2hsShelly $ do-  do_issue_build True cbuild n ext c2hsargs+  do_issue_build True cbuild n "" ext c2hsargs   res <- absPath ("." </> (fromText $ T.pack $ "Issue" <> show n <>                            (if ext == "" then "" else "_" <> ext))) >>= cmd   liftIO $ assertBool "" $ case ordered of@@ -431,7 +454,7 @@  build_issue_with :: Bool -> Bool -> Int -> [Text] -> Assertion build_issue_with strict cbuild n c2hsargs = c2hsShelly $ do-  errExit False $ do_issue_build strict cbuild n "" c2hsargs+  errExit False $ do_issue_build strict cbuild n "" "" c2hsargs   code <- lastExitCode   liftIO $ assertBool "" (code == 0) @@ -443,3 +466,16 @@  hs_only_build_issue :: Int -> Assertion hs_only_build_issue n = build_issue_with True False n []+++build_issue_fails_with :: Bool -> Bool -> Int -> [Text] -> Assertion+build_issue_fails_with strict cbuild n c2hsargs = c2hsShelly $ do+  errExit False $ do_issue_build strict cbuild n "" "" c2hsargs+  code <- lastExitCode+  liftIO $ assertBool "" (code /= 0)++build_issue_fails :: Int -> Assertion+build_issue_fails n = build_issue_fails_with True True n []++hs_only_build_issue_fails :: Int -> Assertion+hs_only_build_issue_fails n = build_issue_fails_with True False n []