Permalink
Browse files

Fix #155

  • Loading branch information...
ian-ross committed Jan 17, 2016
1 parent 097150f commit 73a985f239003e17a5734649822f6c9aec6bb612
View
@@ -163,3 +163,8 @@
/tests/bugs/issue-152/Issue152
/tests/bugs/issue-140/Issue140
/tests/bugs/issue-140/Issue140.hs
+/tests/bugs/issue-152/Issue152.hs
+/tests/bugs/issue-155/Issue155
+/tests/bugs/issue-155/Issue155.hs
+/tests/bugs/issue-152/Issue152.hs
+/tests/bugs/issue-155/Types.hs
View
@@ -100,6 +100,7 @@ Extra-Source-Files:
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
View
@@ -903,7 +903,8 @@ expandHook hook@(CHSPointer isStar cName oalias ptrKind isNewtype oRefType emit
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 @@ expandHook (CHSClass oclassIde classIde typeIde pos) _ =
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 @@ classDef pos className typeName ptrType isNewtype superClasses =
"" -> 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 @@ classDef pos className typeName ptrType isNewtype superClasses =
++ superConstr ++ "(" ++ castFun ++ " p)\n"
++ " " ++ fromMethodName ++ " (" ++ superConstr ++ "p) = "
++ typeConstr ++ "(" ++ castFun ++ " p)\n"
+ addHsDependency "Foreign.Ptr"
instDefs <- castInstDefs classes
return $ instDef ++ instDefs
View
@@ -216,8 +216,8 @@ data HsObject = Pointer {
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
@@ -1,21 +0,0 @@
--- GENERATED by C->Haskell Compiler, version 0.26.2 Budburst, 26 October 2015 (Haskell)
--- Edit the ORIGNAL .chs file instead!
-
-
-{-# LINE 1 "Issue152.chs" #-}
-module Main where
-
-
-
-
-
-f, g :: Int
-f = 4
-{-# LINE 6 "Issue152.chs" #-}
-
-g = 4
-{-# LINE 7 "Issue152.chs" #-}
-
-
-main :: IO ()
-main = putStrLn "OK"
@@ -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;
View
@@ -91,6 +91,7 @@ tests =
, 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 @@ call_capital = c2hsShelly $ chdir "tests/bugs/call_capital" $ do
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

0 comments on commit 73a985f

Please sign in to comment.