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 +4/−3
- src/Language/Cimple.hs +9/−1
- src/Language/Cimple/AST.hs +0/−201
- src/Language/Cimple/Annot.hs +1/−1
- src/Language/Cimple/Ast.hs +201/−0
- src/Language/Cimple/Diagnostics.hs +19/−8
- src/Language/Cimple/Flatten.hs +1/−1
- src/Language/Cimple/IO.hs +1/−1
- src/Language/Cimple/Lexer.x +4/−0
- src/Language/Cimple/Parser.y +1/−1
- src/Language/Cimple/Program.hs +1/−1
- src/Language/Cimple/SemCheck/Includes.hs +1/−1
- src/Language/Cimple/TranslationUnit.hs +1/−1
- src/Language/Cimple/TraverseAst.hs +1/−1
- src/Language/Cimple/TreeParser.y +1/−1
- test/Language/Cimple/AstSpec.hs +39/−0
- test/Language/Cimple/ParserSpec.hs +97/−0
- test/Language/CimpleSpec.hs +0/−97
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 [\"';'\"]"