packages feed

cimple 0.0.7 → 0.0.8

raw patch · 18 files changed

+382/−319 lines, 18 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Language.Cimple.Diagnostics: instance Language.Cimple.Diagnostics.HasLocation lexeme => Language.Cimple.Diagnostics.HasLocation (Language.Cimple.AST.Node lexeme)
+ Language.Cimple: defaultActions' :: AstActions' state
+ Language.Cimple: type AstActions' a = IdentityActions (State a) Text
+ Language.Cimple.Diagnostics: instance Language.Cimple.Diagnostics.HasLocation lexeme => Language.Cimple.Diagnostics.HasLocation (Language.Cimple.Ast.Node lexeme)
+ Language.Cimple.Diagnostics: type Diagnostics' a = DiagnosticsT' [Text] a
+ Language.Cimple.Diagnostics: warn' :: (HasLocation at, HasDiagnostics diags) => FilePath -> at -> Text -> DiagnosticsT' diags ()

Files

cimple.cabal view
@@ -1,5 +1,5 @@ name:                 cimple-version:              0.0.7+version:              0.0.8 synopsis:             Simple C-like programming language homepage:             https://toktok.github.io/ license:              GPL-3@@ -33,7 +33,7 @@     , Language.Cimple.Program   other-modules:       Language.Cimple.Annot-    , Language.Cimple.AST+    , Language.Cimple.Ast     , Language.Cimple.Flatten     , Language.Cimple.Graph     , Language.Cimple.Lexer@@ -115,7 +115,8 @@   hs-source-dirs: test   main-is: testsuite.hs   other-modules:-      Language.CimpleSpec+      Language.Cimple.AstSpec+    , Language.Cimple.ParserSpec     , Language.Cimple.PrettySpec   ghc-options:       -Wall
src/Language/Cimple.hs view
@@ -2,13 +2,16 @@     ( module X     , AstActions     , defaultActions+    , AstActions'+    , defaultActions'     ) where  import           Control.Monad.State.Lazy    (State)+import qualified Control.Monad.State.Strict  as SState import           Data.Text                   (Text)  import           Language.Cimple.Annot       as X-import           Language.Cimple.AST         as X+import           Language.Cimple.Ast         as X import           Language.Cimple.Lexer       as X import           Language.Cimple.Parser      as X import           Language.Cimple.Tokens      as X@@ -18,3 +21,8 @@  defaultActions :: AstActions state defaultActions = X.identityActions++type AstActions' a = X.IdentityActions (SState.State a) Text++defaultActions' :: AstActions' state+defaultActions' = X.identityActions
− src/Language/Cimple/AST.hs
@@ -1,201 +0,0 @@-{-# LANGUAGE DeriveFunctor      #-}-{-# LANGUAGE DeriveGeneric      #-}-{-# LANGUAGE DeriveTraversable  #-}-{-# LANGUAGE DerivingVia        #-}-{-# LANGUAGE FlexibleInstances  #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE StrictData         #-}-module Language.Cimple.AST-    ( AssignOp (..)-    , BinaryOp (..)-    , UnaryOp (..)-    , LiteralType (..)-    , Node, NodeF (..)-    , Scope (..)-    , CommentStyle (..)-    ) where--import           Data.Aeson                   (FromJSON, FromJSON1, ToJSON,-                                               ToJSON1)-import           Data.Fix                     (Fix)-import           Data.Functor.Classes         (Eq1, Read1, Show1)-import           Data.Functor.Classes.Generic (FunctorClassesDefault (..))-import           GHC.Generics                 (Generic, Generic1)--data NodeF lexeme a-    -- Preprocessor-    = PreprocInclude lexeme-    | PreprocDefine lexeme-    | PreprocDefineConst lexeme a-    | PreprocDefineMacro lexeme [a] a-    | PreprocIf a [a] a-    | PreprocIfdef lexeme [a] a-    | PreprocIfndef lexeme [a] a-    | PreprocElse [a]-    | PreprocElif a [a] a-    | PreprocUndef lexeme-    | PreprocDefined lexeme-    | PreprocScopedDefine a [a] a-    | MacroBodyStmt a-    | MacroBodyFunCall a-    | MacroParam lexeme-    | StaticAssert a lexeme-    -- Comments-    | LicenseDecl lexeme [a]-    | CopyrightDecl lexeme (Maybe lexeme) [lexeme]-    | Comment CommentStyle lexeme [lexeme] lexeme-    | CommentBlock lexeme-    | Commented a a-    -- Namespace-like blocks-    | ExternC [a]-    -- Statements-    | CompoundStmt [a]-    | Break-    | Goto lexeme-    | Continue-    | Return (Maybe a)-    | SwitchStmt a [a]-    | IfStmt a a (Maybe a)-    | ForStmt a a a a-    | WhileStmt a a-    | DoWhileStmt a a-    | Case a a-    | Default a-    | Label lexeme a-    -- Variable declarations-    | VLA a lexeme a-    | VarDecl a a-    | Declarator a (Maybe a)-    | DeclSpecVar lexeme-    | DeclSpecArray a (Maybe a)-    -- Expressions-    | InitialiserList [a]-    | UnaryExpr UnaryOp a-    | BinaryExpr a BinaryOp a-    | TernaryExpr a a a-    | AssignExpr a AssignOp a-    | ParenExpr a-    | CastExpr a a-    | CompoundExpr a a-    | SizeofExpr a-    | SizeofType a-    | LiteralExpr LiteralType lexeme-    | VarExpr lexeme-    | MemberAccess a lexeme-    | PointerAccess a lexeme-    | ArrayAccess a a-    | FunctionCall a [a]-    | CommentExpr a a-    -- Type definitions-    | EnumConsts (Maybe lexeme) [a]-    | EnumDecl lexeme [a] lexeme-    | Enumerator lexeme (Maybe a)-    | Typedef a lexeme-    | TypedefFunction a-    | Struct lexeme [a]-    | Union lexeme [a]-    | MemberDecl a a (Maybe lexeme)-    | TyConst a-    | TyPointer a-    | TyStruct lexeme-    | TyFunc lexeme-    | TyStd lexeme-    | TyUserDefined lexeme-    -- Functions-    | FunctionDecl Scope a-    | FunctionDefn Scope a a-    | FunctionPrototype a lexeme [a]-    | FunctionParam a a-    | Ellipsis-    -- Constants-    | ConstDecl a lexeme-    | ConstDefn Scope a lexeme a-    deriving (Show, Read, Eq, Generic, Generic1, Functor, Foldable, Traversable)-    deriving (Show1, Read1, Eq1) via FunctorClassesDefault (NodeF lexeme)--type Node lexeme = Fix (NodeF lexeme)--instance FromJSON lexeme => FromJSON1 (NodeF lexeme)-instance ToJSON lexeme => ToJSON1 (NodeF lexeme)--data AssignOp-    = AopEq-    | AopMul-    | AopDiv-    | AopPlus-    | AopMinus-    | AopBitAnd-    | AopBitOr-    | AopBitXor-    | AopMod-    | AopLsh-    | AopRsh-    deriving (Show, Read, Eq, Generic)--instance FromJSON AssignOp-instance ToJSON AssignOp--data BinaryOp-    = BopNe-    | BopEq-    | BopOr-    | BopBitXor-    | BopBitOr-    | BopAnd-    | BopBitAnd-    | BopDiv-    | BopMul-    | BopMod-    | BopPlus-    | BopMinus-    | BopLt-    | BopLe-    | BopLsh-    | BopGt-    | BopGe-    | BopRsh-    deriving (Show, Read, Eq, Generic)--instance FromJSON BinaryOp-instance ToJSON BinaryOp--data UnaryOp-    = UopNot-    | UopNeg-    | UopMinus-    | UopAddress-    | UopDeref-    | UopIncr-    | UopDecr-    deriving (Show, Read, Eq, Generic)--instance FromJSON UnaryOp-instance ToJSON UnaryOp--data LiteralType-    = Char-    | Int-    | Bool-    | String-    | ConstId-    deriving (Show, Read, Eq, Generic)--instance FromJSON LiteralType-instance ToJSON LiteralType--data Scope-    = Global-    | Static-    deriving (Show, Read, Eq, Generic)--instance FromJSON Scope-instance ToJSON Scope--data CommentStyle-    = Regular-    | Doxygen-    | Block-    deriving (Show, Read, Eq, Generic)--instance FromJSON CommentStyle-instance ToJSON CommentStyle
src/Language/Cimple/Annot.hs view
@@ -18,7 +18,7 @@ import           Data.Functor.Classes.Generic (FunctorClassesDefault (..)) import           Data.Functor.Compose         (Compose (..)) import           GHC.Generics                 (Generic, Generic1)-import           Language.Cimple.AST          (Node, NodeF)+import           Language.Cimple.Ast          (Node, NodeF)  data AnnotF attr a = Annot { attr :: attr, unAnnot :: a }     deriving (Functor, Generic, Generic1)
+ src/Language/Cimple/Ast.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE DeriveTraversable  #-}+{-# LANGUAGE DerivingVia        #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE StrictData         #-}+module Language.Cimple.Ast+    ( AssignOp (..)+    , BinaryOp (..)+    , UnaryOp (..)+    , LiteralType (..)+    , Node, NodeF (..)+    , Scope (..)+    , CommentStyle (..)+    ) where++import           Data.Aeson                   (FromJSON, FromJSON1, ToJSON,+                                               ToJSON1)+import           Data.Fix                     (Fix)+import           Data.Functor.Classes         (Eq1, Read1, Show1)+import           Data.Functor.Classes.Generic (FunctorClassesDefault (..))+import           GHC.Generics                 (Generic, Generic1)++data NodeF lexeme a+    -- Preprocessor+    = PreprocInclude lexeme+    | PreprocDefine lexeme+    | PreprocDefineConst lexeme a+    | PreprocDefineMacro lexeme [a] a+    | PreprocIf a [a] a+    | PreprocIfdef lexeme [a] a+    | PreprocIfndef lexeme [a] a+    | PreprocElse [a]+    | PreprocElif a [a] a+    | PreprocUndef lexeme+    | PreprocDefined lexeme+    | PreprocScopedDefine a [a] a+    | MacroBodyStmt a+    | MacroBodyFunCall a+    | MacroParam lexeme+    | StaticAssert a lexeme+    -- Comments+    | LicenseDecl lexeme [a]+    | CopyrightDecl lexeme (Maybe lexeme) [lexeme]+    | Comment CommentStyle lexeme [lexeme] lexeme+    | CommentBlock lexeme+    | Commented a a+    -- Namespace-like blocks+    | ExternC [a]+    -- Statements+    | CompoundStmt [a]+    | Break+    | Goto lexeme+    | Continue+    | Return (Maybe a)+    | SwitchStmt a [a]+    | IfStmt a a (Maybe a)+    | ForStmt a a a a+    | WhileStmt a a+    | DoWhileStmt a a+    | Case a a+    | Default a+    | Label lexeme a+    -- Variable declarations+    | VLA a lexeme a+    | VarDecl a a+    | Declarator a (Maybe a)+    | DeclSpecVar lexeme+    | DeclSpecArray a (Maybe a)+    -- Expressions+    | InitialiserList [a]+    | UnaryExpr UnaryOp a+    | BinaryExpr a BinaryOp a+    | TernaryExpr a a a+    | AssignExpr a AssignOp a+    | ParenExpr a+    | CastExpr a a+    | CompoundExpr a a+    | SizeofExpr a+    | SizeofType a+    | LiteralExpr LiteralType lexeme+    | VarExpr lexeme+    | MemberAccess a lexeme+    | PointerAccess a lexeme+    | ArrayAccess a a+    | FunctionCall a [a]+    | CommentExpr a a+    -- Type definitions+    | EnumConsts (Maybe lexeme) [a]+    | EnumDecl lexeme [a] lexeme+    | Enumerator lexeme (Maybe a)+    | Typedef a lexeme+    | TypedefFunction a+    | Struct lexeme [a]+    | Union lexeme [a]+    | MemberDecl a a (Maybe lexeme)+    | TyConst a+    | TyPointer a+    | TyStruct lexeme+    | TyFunc lexeme+    | TyStd lexeme+    | TyUserDefined lexeme+    -- Functions+    | FunctionDecl Scope a+    | FunctionDefn Scope a a+    | FunctionPrototype a lexeme [a]+    | FunctionParam a a+    | Ellipsis+    -- Constants+    | ConstDecl a lexeme+    | ConstDefn Scope a lexeme a+    deriving (Show, Read, Eq, Generic, Generic1, Functor, Foldable, Traversable)+    deriving (Show1, Read1, Eq1) via FunctorClassesDefault (NodeF lexeme)++type Node lexeme = Fix (NodeF lexeme)++instance FromJSON lexeme => FromJSON1 (NodeF lexeme)+instance ToJSON lexeme => ToJSON1 (NodeF lexeme)++data AssignOp+    = AopEq+    | AopMul+    | AopDiv+    | AopPlus+    | AopMinus+    | AopBitAnd+    | AopBitOr+    | AopBitXor+    | AopMod+    | AopLsh+    | AopRsh+    deriving (Show, Read, Eq, Generic)++instance FromJSON AssignOp+instance ToJSON AssignOp++data BinaryOp+    = BopNe+    | BopEq+    | BopOr+    | BopBitXor+    | BopBitOr+    | BopAnd+    | BopBitAnd+    | BopDiv+    | BopMul+    | BopMod+    | BopPlus+    | BopMinus+    | BopLt+    | BopLe+    | BopLsh+    | BopGt+    | BopGe+    | BopRsh+    deriving (Show, Read, Eq, Generic)++instance FromJSON BinaryOp+instance ToJSON BinaryOp++data UnaryOp+    = UopNot+    | UopNeg+    | UopMinus+    | UopAddress+    | UopDeref+    | UopIncr+    | UopDecr+    deriving (Show, Read, Eq, Generic)++instance FromJSON UnaryOp+instance ToJSON UnaryOp++data LiteralType+    = Char+    | Int+    | Bool+    | String+    | ConstId+    deriving (Show, Read, Eq, Generic)++instance FromJSON LiteralType+instance ToJSON LiteralType++data Scope+    = Global+    | Static+    deriving (Show, Read, Eq, Generic)++instance FromJSON Scope+instance ToJSON Scope++data CommentStyle+    = Regular+    | Doxygen+    | Block+    deriving (Show, Read, Eq, Generic)++instance FromJSON CommentStyle+instance ToJSON CommentStyle
src/Language/Cimple/Diagnostics.hs view
@@ -3,19 +3,22 @@ {-# LANGUAGE StrictData        #-} module Language.Cimple.Diagnostics   ( Diagnostics+  , Diagnostics'   , HasDiagnostics (..)   , warn+  , warn'   , sloc   ) where -import           Control.Monad.State.Lazy (State)-import qualified Control.Monad.State.Lazy as State-import           Data.Fix                 (foldFix)-import           Data.Text                (Text)-import qualified Data.Text                as Text-import           Language.Cimple.AST      (Node)-import qualified Language.Cimple.Flatten  as Flatten-import           Language.Cimple.Lexer    (Lexeme (..), lexemeLine)+import           Control.Monad.State.Lazy   (State)+import qualified Control.Monad.State.Lazy   as State+import qualified Control.Monad.State.Strict as SState+import           Data.Fix                   (foldFix)+import           Data.Text                  (Text)+import qualified Data.Text                  as Text+import           Language.Cimple.Ast        (Node)+import qualified Language.Cimple.Flatten    as Flatten+import           Language.Cimple.Lexer      (Lexeme (..), lexemeLine)  type DiagnosticsT diags a = State diags a type Diagnostics a = DiagnosticsT [Text] a@@ -24,6 +27,14 @@     :: (HasLocation at, HasDiagnostics diags)     => FilePath -> at -> Text -> DiagnosticsT diags () warn file l w = State.modify (addDiagnostic $ sloc file l <> ": " <> w)++type DiagnosticsT' diags a = SState.State diags a+type Diagnostics' a = DiagnosticsT' [Text] a++warn'+    :: (HasLocation at, HasDiagnostics diags)+    => FilePath -> at -> Text -> DiagnosticsT' diags ()+warn' file l w = SState.modify (addDiagnostic $ sloc file l <> ": " <> w)   class HasDiagnostics a where
src/Language/Cimple/Flatten.hs view
@@ -8,7 +8,7 @@  import           Data.Maybe          (maybeToList) import           GHC.Generics-import           Language.Cimple.AST (AssignOp, BinaryOp, CommentStyle,+import           Language.Cimple.Ast (AssignOp, BinaryOp, CommentStyle,                                       LiteralType, NodeF (..), Scope, UnaryOp)  class Concats t a where
src/Language/Cimple/IO.hs view
@@ -14,7 +14,7 @@ import           Data.Text                       (Text) import qualified Data.Text                       as Text import qualified Data.Text.Encoding              as Text-import           Language.Cimple.AST             (Node)+import           Language.Cimple.Ast             (Node) import           Language.Cimple.Lexer           (Lexeme, runAlex) import qualified Language.Cimple.Parser          as Parser import           Language.Cimple.Program         (Program)
src/Language/Cimple/Lexer.x view
@@ -67,6 +67,10 @@ <0>		"ifconf"				{ mkL IdSueType } <0>		"ifreq"					{ mkL IdSueType } <0>		"epoll_event"				{ mkL IdSueType }+<0>		"ev_async"				{ mkL IdSueType }+<0>		"ev_io"					{ mkL IdSueType }+<0>		"ev_loop"				{ mkL IdSueType }+<0>		"fd_set"				{ mkL IdSueType } <0>		"in_addr"				{ mkL IdSueType } <0>		"in6_addr"				{ mkL IdSueType } <0>		"ipv6_mreq"				{ mkL IdSueType }
src/Language/Cimple/Parser.y view
@@ -4,7 +4,7 @@     ) where  import           Data.Fix               (Fix (..))-import           Language.Cimple.AST    (AssignOp (..), BinaryOp (..),+import           Language.Cimple.Ast    (AssignOp (..), BinaryOp (..),                                          CommentStyle (..), LiteralType (..),                                          Node, NodeF (..), Scope (..),                                          UnaryOp (..))
src/Language/Cimple/Program.hs view
@@ -10,7 +10,7 @@ import           Data.Map.Strict                   (Map) import qualified Data.Map.Strict                   as Map import           Data.Text                         (Text)-import           Language.Cimple.AST               (Node)+import           Language.Cimple.Ast               (Node) import           Language.Cimple.Graph             (Graph) import qualified Language.Cimple.Graph             as Graph import           Language.Cimple.Lexer             (Lexeme (..))
src/Language/Cimple/SemCheck/Includes.hs view
@@ -9,7 +9,7 @@ import           Data.Fix                        (Fix (..)) import           Data.Text                       (Text) import qualified Data.Text                       as Text-import           Language.Cimple.AST             (NodeF (..))+import           Language.Cimple.Ast             (NodeF (..)) import           Language.Cimple.Lexer           (Lexeme (..)) import           Language.Cimple.Tokens          (LexemeClass (..)) import           Language.Cimple.TranslationUnit (TranslationUnit)
src/Language/Cimple/TranslationUnit.hs view
@@ -3,7 +3,7 @@   ( TranslationUnit   ) where -import           Language.Cimple.AST   (Node)+import           Language.Cimple.Ast   (Node) import           Language.Cimple.Lexer (Lexeme)  type TranslationUnit text = (FilePath, [Node (Lexeme text)])
src/Language/Cimple/TraverseAst.hs view
@@ -21,7 +21,7 @@     ) where  import           Data.Fix              (Fix (..))-import           Language.Cimple.AST   (Node, NodeF (..))+import           Language.Cimple.Ast   (Node, NodeF (..)) import           Language.Cimple.Lexer (Lexeme (..))  class TraverseAst itext otext a where
src/Language/Cimple/TreeParser.y view
@@ -8,7 +8,7 @@  import           Data.Fix              (Fix (..)) import           Data.Text             (Text)-import           Language.Cimple.AST   (CommentStyle (..), Node, NodeF (..))+import           Language.Cimple.Ast   (CommentStyle (..), Node, NodeF (..)) import           Language.Cimple.Lexer (Lexeme) } 
+ test/Language/Cimple/AstSpec.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns      #-}+module Language.Cimple.AstSpec where++import           Data.Fix             (Fix (..))+import           Data.Functor.Compose (Compose (..))+import           Test.Hspec           (Spec, describe, it, shouldBe,+                                       shouldSatisfy)++import           Language.Cimple      (AlexPosn (..), AnnotF (..), Lexeme (..),+                                       LexemeClass (..), LiteralType (..),+                                       NodeF (..), Scope (..), addAnnot,+                                       removeAnnot)+import           Language.Cimple.IO   (parseText)+++spec :: Spec+spec = do+    describe "Node" $ do+        it "can be annotated" $ do+            let Right [ast] = parseText "const int a = 3;"+            addAnnot ast `shouldBe`+                Fix (Compose (Annot () (+                    ConstDefn Global+                        (Fix (Compose (Annot () (+                            TyStd (L (AlexPn 6 1 7) IdStdType "int")))))+                        (L (AlexPn 10 1 11) IdVar "a")+                        (Fix (Compose (Annot () (+                            LiteralExpr Int (L (AlexPn 14 1 15) LitInteger "3"))))))))++            removeAnnot (addAnnot ast) `shouldBe` ast++            addAnnot ast `shouldSatisfy` \case+                (removeAnnot -> Fix (ConstDefn Global+                    (Fix (TyStd (L (AlexPn 6 1 7) IdStdType "int")))+                    (L (AlexPn 10 1 11) IdVar "a")+                    (Fix (LiteralExpr Int (L (AlexPn 14 1 15) LitInteger "3"))))) -> True+                _ -> False
+ test/Language/Cimple/ParserSpec.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.Cimple.ParserSpec where++import           Data.Fix           (Fix (..))+import           Test.Hspec         (Spec, describe, it, shouldBe)++import           Language.Cimple    (AlexPosn (..), CommentStyle (..),+                                     Lexeme (..), LexemeClass (..),+                                     LiteralType (..), NodeF (..), Scope (..))+import           Language.Cimple.IO (parseText)+++spec :: Spec+spec = do+    describe "C parsing" $ do+        it "should parse a simple function" $ do+            let ast = parseText "int a(void) { return 3; }"+            ast `shouldBe` Right+                [ Fix (FunctionDefn+                      Global+                      (Fix (FunctionPrototype+                          (Fix (TyStd (L (AlexPn 0 1 1) IdStdType "int")))+                          (L (AlexPn 4 1 5) IdVar "a")+                          [Fix (TyStd (L (AlexPn 6 1 7) KwVoid "void"))]+                      ))+                      (Fix (CompoundStmt [ Fix (Return+                            (Just+                                (Fix (LiteralExpr+                                    Int+                                    (L (AlexPn 21 1 22) LitInteger "3")+                                ))+                            ))+                      ])))+                ]++        it "should parse a type declaration" $ do+            let ast = parseText "typedef struct Foo { int x; } Foo;"+            ast `shouldBe` Right+                [ Fix (Typedef+                      (Fix (Struct+                          (L (AlexPn 15 1 16) IdSueType "Foo")+                          [ Fix (MemberDecl+                                (Fix (TyStd (L (AlexPn 21 1 22) IdStdType "int")))+                                (Fix (DeclSpecVar (L (AlexPn 25 1 26) IdVar "x")))+                                Nothing)+                          ]+                      ))+                      (L (AlexPn 30 1 31) IdSueType "Foo"))+                ]++        it "should parse a struct with bit fields" $ do+            let ast = parseText "typedef struct Foo { int x : 123; } Foo;"+            ast `shouldBe` Right+                [ Fix (Typedef+                      (Fix (Struct+                          (L (AlexPn 15 1 16) IdSueType "Foo")+                          [ Fix (MemberDecl+                                (Fix (TyStd (L (AlexPn 21 1 22) IdStdType "int")))+                                (Fix (DeclSpecVar (L (AlexPn 25 1 26) IdVar "x")))+                                (Just (L (AlexPn 29 1 30) LitInteger "123")))+                          ]+                      ))+                      (L (AlexPn 36 1 37) IdSueType "Foo"))+                ]++        it "should parse a comment" $ do+            let ast = parseText "/* hello */"+            ast `shouldBe` Right+                [ Fix (Comment Regular+                          (L (AlexPn 0 1 1) CmtStart "/*")+                          [L (AlexPn 3 1 4) CmtWord "hello"]+                          (L (AlexPn 9 1 10) CmtEnd "*/"))+                ]++        it "supports single declarators" $ do+            let ast = parseText "int main() { int a; }"+            ast `shouldBe` Right+                [ Fix (FunctionDefn+                      Global+                      (Fix (FunctionPrototype+                          (Fix (TyStd (L (AlexPn 0 1 1) IdStdType "int")))+                          (L (AlexPn 4 1 5) IdVar "main")+                          []+                      ))+                      (Fix (CompoundStmt [ Fix (VarDecl+                            (Fix (TyStd (L (AlexPn 13 1 14) IdStdType "int")))+                            (Fix (Declarator+                                (Fix (DeclSpecVar (L (AlexPn 17 1 18) IdVar "a")))+                                Nothing+                            )))+                      ])))+                ]++        it "does not support multiple declarators per declaration" $ do+            let ast = parseText "int main() { int a, b; }"+            ast `shouldBe` Left+                "1:19: Parse error near PctComma: \",\"; expected one of [\"';'\"]"
− test/Language/CimpleSpec.hs
@@ -1,97 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Language.CimpleSpec where--import           Data.Fix           (Fix (..))-import           Test.Hspec         (Spec, describe, it, shouldBe)--import           Language.Cimple    (AlexPosn (..), CommentStyle (..),-                                     Lexeme (..), LexemeClass (..),-                                     LiteralType (..), NodeF (..), Scope (..))-import           Language.Cimple.IO (parseText)---spec :: Spec-spec = do-    describe "C parsing" $ do-        it "should parse a simple function" $ do-            let ast = parseText "int a(void) { return 3; }"-            ast `shouldBe` Right-                [ Fix (FunctionDefn-                      Global-                      (Fix (FunctionPrototype-                          (Fix (TyStd (L (AlexPn 0 1 1) IdStdType "int")))-                          (L (AlexPn 4 1 5) IdVar "a")-                          [Fix (TyStd (L (AlexPn 6 1 7) KwVoid "void"))]-                      ))-                      (Fix (CompoundStmt [ Fix (Return-                            (Just-                                (Fix (LiteralExpr-                                    Int-                                    (L (AlexPn 21 1 22) LitInteger "3")-                                ))-                            ))-                      ])))-                ]--        it "should parse a type declaration" $ do-            let ast = parseText "typedef struct Foo { int x; } Foo;"-            ast `shouldBe` Right-                [ Fix (Typedef-                      (Fix (Struct-                          (L (AlexPn 15 1 16) IdSueType "Foo")-                          [ Fix (MemberDecl-                                (Fix (TyStd (L (AlexPn 21 1 22) IdStdType "int")))-                                (Fix (DeclSpecVar (L (AlexPn 25 1 26) IdVar "x")))-                                Nothing)-                          ]-                      ))-                      (L (AlexPn 30 1 31) IdSueType "Foo"))-                ]--        it "should parse a struct with bit fields" $ do-            let ast = parseText "typedef struct Foo { int x : 123; } Foo;"-            ast `shouldBe` Right-                [ Fix (Typedef-                      (Fix (Struct-                          (L (AlexPn 15 1 16) IdSueType "Foo")-                          [ Fix (MemberDecl-                                (Fix (TyStd (L (AlexPn 21 1 22) IdStdType "int")))-                                (Fix (DeclSpecVar (L (AlexPn 25 1 26) IdVar "x")))-                                (Just (L (AlexPn 29 1 30) LitInteger "123")))-                          ]-                      ))-                      (L (AlexPn 36 1 37) IdSueType "Foo"))-                ]--        it "should parse a comment" $ do-            let ast = parseText "/* hello */"-            ast `shouldBe` Right-                [ Fix (Comment Regular-                          (L (AlexPn 0 1 1) CmtStart "/*")-                          [L (AlexPn 3 1 4) CmtWord "hello"]-                          (L (AlexPn 9 1 10) CmtEnd "*/"))-                ]--        it "supports single declarators" $ do-            let ast = parseText "int main() { int a; }"-            ast `shouldBe` Right-                [ Fix (FunctionDefn-                      Global-                      (Fix (FunctionPrototype-                          (Fix (TyStd (L (AlexPn 0 1 1) IdStdType "int")))-                          (L (AlexPn 4 1 5) IdVar "main")-                          []-                      ))-                      (Fix (CompoundStmt [ Fix (VarDecl-                            (Fix (TyStd (L (AlexPn 13 1 14) IdStdType "int")))-                            (Fix (Declarator-                                (Fix (DeclSpecVar (L (AlexPn 17 1 18) IdVar "a")))-                                Nothing-                            )))-                      ])))-                ]--        it "does not support multiple declarators per declaration" $ do-            let ast = parseText "int main() { int a, b; }"-            ast `shouldBe` Left-                "1:19: Parse error near PctComma: \",\"; expected one of [\"';'\"]"