Primitive types "failing test"

hs-bindgen/examples/enums.h

@@ -0,0 +1,9 @@
+#ifndef ENUMS_H
+#define ENUMS_H
+
+enum first {
+    FIRST1,
+    FIRST2
+};
+
+#endif /* ENUMS_H */

hs-bindgen/examples/primitive_types.h

@@ -0,0 +1,40 @@
+struct primitive {
+    char c;
+    signed char sc;
+    unsigned char uc;
+
+    short s;
+    short int si;
+    signed short ss;
+    signed short int ssi;
+
+    unsigned short us;
+    unsigned short int usi;
+
+    int i;
+    signed s2;
+    signed int si2;
+
+    unsigned u;
+    unsigned int ui;
+
+    long l;
+    long int li;
+    signed long sl;
+    signed long int sli;
+
+    unsigned long ul;
+    unsigned long int uli;
+
+    long long ll;
+    long long int lli;
+    signed long long sll;
+    signed long long int slli;
+
+    unsigned long long ull;
+    unsigned long long int ulli;
+
+    float f;
+    double d;
+    long double ld;
+};

hs-bindgen/fixtures/enums.dump.txt

@@ -0,0 +1,3 @@
+"first" :: "Enum"
+  "FIRST1" :: "Int"
+  "FIRST2" :: "Int"

hs-bindgen/fixtures/enums.tree-diff.txt

@@ -0,0 +1 @@
+WrapCHeader (Header [])

hs-bindgen/fixtures/primitive_types.dump.txt

@@ -0,0 +1,30 @@
+"primitive" :: "Record"
+  "c" :: "Char_S"
+  "sc" :: "SChar"
+  "uc" :: "UChar"
+  "s" :: "Short"
+  "si" :: "Short"
+  "ss" :: "Short"
+  "ssi" :: "Short"
+  "us" :: "UShort"
+  "usi" :: "UShort"
+  "i" :: "Int"
+  "s2" :: "Int"
+  "si2" :: "Int"
+  "u" :: "UInt"
+  "ui" :: "UInt"
+  "l" :: "Long"
+  "li" :: "Long"
+  "sl" :: "Long"
+  "sli" :: "Long"
+  "ul" :: "ULong"
+  "uli" :: "ULong"
+  "ll" :: "LongLong"
+  "lli" :: "LongLong"
+  "sll" :: "LongLong"
+  "slli" :: "LongLong"
+  "ull" :: "ULongLong"
+  "ulli" :: "ULongLong"
+  "f" :: "Float"
+  "d" :: "Double"
+  "ld" :: "LongDouble"

hs-bindgen/fixtures/primitive_types.tree-diff.txt

@@ -0,0 +1,24 @@
+WrapCHeader
+  (Header
+    [
+      DeclStruct
+        Struct {
+          structTag = Just "primitive",
+          structSizeof = 176,
+          structAlignment = 16,
+          structFields = [
+            StructField {
+              fieldName = "c",
+              fieldType = PrimChar},
+            StructField {
+              fieldName = "i",
+              fieldType = PrimInt},
+            StructField {
+              fieldName = "s2",
+              fieldType = PrimInt},
+            StructField {
+              fieldName = "si2",
+              fieldType = PrimInt},
+            StructField {
+              fieldName = "f",
+              fieldType = PrimFloat}]}])

hs-bindgen/fixtures/simple_structs.tree-diff.txt

@@ -0,0 +1,69 @@
+WrapCHeader
+  (Header
+    [
+      DeclStruct
+        Struct {
+          structTag = Just "S1",
+          structSizeof = 8,
+          structAlignment = 4,
+          structFields = [
+            StructField {
+              fieldName = "a",
+              fieldType = PrimInt},
+            StructField {
+              fieldName = "b",
+              fieldType = PrimChar}]},
+      DeclStruct
+        Struct {
+          structTag = Just "S2",
+          structSizeof = 12,
+          structAlignment = 4,
+          structFields = [
+            StructField {
+              fieldName = "a",
+              fieldType = PrimChar},
+            StructField {
+              fieldName = "b",
+              fieldType = PrimInt},
+            StructField {
+              fieldName = "c",
+              fieldType = PrimFloat}]},
+      DeclTypedef
+        Typedef {
+          typedefName = "S2_t",
+          typedefType = TypStruct
+            Struct {
+              structTag = Just "S2",
+              structSizeof = 12,
+              structAlignment = 4,
+              structFields = [
+                StructField {
+                  fieldName = "a",
+                  fieldType = PrimChar},
+                StructField {
+                  fieldName = "b",
+                  fieldType = PrimInt},
+                StructField {
+                  fieldName = "c",
+                  fieldType = PrimFloat}]}},
+      DeclStruct
+        Struct {
+          structTag = Nothing,
+          structSizeof = 1,
+          structAlignment = 1,
+          structFields = [
+            StructField {
+              fieldName = "a",
+              fieldType = PrimChar}]},
+      DeclTypedef
+        Typedef {
+          typedefName = "S3_t",
+          typedefType = TypStruct
+            Struct {
+              structTag = Nothing,
+              structSizeof = 1,
+              structAlignment = 1,
+              structFields = [
+                StructField {
+                  fieldName = "a",
+                  fieldType = PrimChar}]}}])

hs-bindgen/hs-bindgen.cabal

@@ -40,7 +40,7 @@ library
   exposed-modules:
       HsBindgen.Lib
       HsBindgen.TH
-  other-modules:
+  exposed-modules:
       HsBindgen.C.AST
       HsBindgen.C.Parser
       HsBindgen.Hs.Annotation
@@ -89,6 +89,7 @@ test-suite golden
   type:           exitcode-stdio-1.0
   main-is:        golden.hs
   hs-source-dirs: tests
+  other-modules:  Orphans
   build-depends:
       -- Internal dependencies
     , hs-bindgen
@@ -97,9 +98,11 @@ test-suite golden
       -- Inherited dependencies
     , containers
     , bytestring
+    , template-haskell
   build-depends:
       -- External dependencies
     , directory    ^>=1.3.6.2
     , filepath     ^>=1.4.2.2 || ^>=1.5.2.0
     , tasty        ^>=1.5
     , tasty-golden ^>=2.3.5
+    , tree-diff    ^>=0.3.1

hs-bindgen/src/HsBindgen/Lib.hs

@@ -39,12 +39,14 @@ module HsBindgen.Lib (
 
     -- * Logging
   , Tracer
+  , nullTracer
   , contramap
   , PrettyLogMsg(..)
   , mkTracerIO
   ) where
 
 import Data.Tree (Forest)
+import GHC.Generics (Generic)
 import Language.Haskell.Exts qualified as Hs
 import Language.Haskell.Meta qualified as Meta
 import Language.Haskell.TH qualified as TH
@@ -70,6 +72,7 @@ import HsBindgen.Util.Tracer
 newtype CHeader = WrapCHeader {
       unwrapCHeader :: C.Header
     }
+  deriving (Eq, Generic)
 
 newtype HsModule = WrapHsModule {
       unwrapHsModule :: Hs.Module Ann

hs-bindgen/src/HsBindgen/Util/Tracer.hs

@@ -5,6 +5,7 @@
 -- Indended for unqualified import.
 module HsBindgen.Util.Tracer (
     Tracer -- opaque
+  , nullTracer
   , PrettyLogMsg(..)
     -- * Using the tracer
   , Level(..)
@@ -42,6 +43,9 @@ traceWith t l a = Contra.traceWith (unwrap t) (l, a)
   Internal: general tracer construction
 -------------------------------------------------------------------------------}
 
+nullTracer :: Monad m => Tracer m a
+nullTracer = Wrap Contra.nullTracer
+
 mkTracer :: forall m a.
      Monad m
   => (a -> m ())  -- ^ Output error
@@ -96,4 +100,4 @@ mkTracerQ  =
 -------------------------------------------------------------------------------}
 
 class PrettyLogMsg a where
-  prettyLogMsg :: a -> String
+  prettyLogMsg :: a -> String

hs-bindgen/tests/Orphans.hs

@@ -0,0 +1,16 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+module Orphans where
+
+import Data.TreeDiff.Class (ToExpr)
+
+import HsBindgen.Lib
+import HsBindgen.C.AST qualified as C
+
+instance ToExpr CHeader
+instance ToExpr C.Header
+instance ToExpr C.Decl
+instance ToExpr C.Struct
+instance ToExpr C.Typedef
+instance ToExpr C.Typ
+instance ToExpr C.PrimType
+instance ToExpr C.StructField

hs-bindgen/tests/golden.hs

@@ -6,6 +6,11 @@ import System.Directory (doesFileExist, setCurrentDirectory)
 import System.FilePath ((</>), (-<.>))
 import Test.Tasty (defaultMain, testGroup)
 import Test.Tasty.Golden (goldenVsStringDiff)
+import Test.Tasty.Golden.Advanced (goldenTest)
+import Language.Haskell.TH.Ppr (ppr)
+import Data.TreeDiff.Golden (ediffGolden)
+
+import Orphans ()
 
 import HsBindgen.Clang.Util.Classification
 import HsBindgen.Lib
@@ -14,16 +19,47 @@ main :: IO ()
 main = do
     findPackageDirectory "hs-bindgen"
     defaultMain $ testGroup "golden"
-        [ goldenVsStringDiff "simple_structs" diff "fixtures/simple_structs.dump.txt" $ do
-            let fp = "examples/simple_structs.h"
-                args = []
-            res <- getClangAST args fp
-
-            return $ LBS8.pack $ unlines $ concatMap treeToLines res
+        [ golden "simple_structs"
+        , golden "enums"
+        , golden "primitive_types"
         ]
   where
     diff ref new = ["diff", "-u", ref, new]
 
+    golden name = testGroup name
+        [ goldenDump name
+        , goldenTreeDiff name
+        , goldenTH name
+        ]
+
+    goldenDump name = goldenVsStringDiff "ast" diff ("fixtures" </> (name ++ ".dump.txt")) $ do
+        -- -<.> does weird stuff for filenames with multiple dots;
+        -- I usually simply avoid using it.
+        let fp = "examples" </> (name ++ ".h")
+            args = ["-target", "x86_64-pc-linux-gnu"]
+
+        res <- getClangAST args fp
+
+        return $ LBS8.pack $ unlines $ concatMap treeToLines res
+
+    goldenTreeDiff name = ediffGolden goldenTest "treediff" ("fixtures" </> (name ++ ".tree-diff.txt")) $ do
+        let fp = "examples" </> (name ++ ".h")
+            args = ["-target", "x86_64-pc-linux-gnu"]
+
+        header <- parseCHeader nullTracer args fp
+        return header
+
+    goldenTH name = goldenVsStringDiff "th" diff ("fixtures" </> (name ++ ".th.txt")) $ do
+        -- -<.> does weird stuff for filenames with multiple dots;
+        -- I usually simply avoid using it.
+        let fp = "examples" </> (name ++ ".h")
+            args = ["-target", "x86_64-pc-linux-gnu"]
+
+        header <- parseCHeader nullTracer args fp
+        let decls = genDecls header
+
+        return $ LBS8.pack $ unlines $ map (show . ppr) decls
+
 treeToLines :: Tree Element -> [String]
 treeToLines tree = go 0 tree [] where
     go :: Int -> Tree Element -> [String] -> [String]