diff --git a/cimple.cabal b/cimple.cabal --- a/cimple.cabal +++ b/cimple.cabal @@ -1,5 +1,5 @@ name: cimple -version: 0.0.29 +version: 0.0.30 synopsis: Simple C-like programming language homepage: https://toktok.github.io/ license: GPL-3 @@ -125,6 +125,7 @@ Language.Cimple.ParserSpec Language.Cimple.PrettyCommentSpec Language.Cimple.PrettySpec + Language.Cimple.DiagnosticsSpec Language.CimpleSpec ghc-options: -Wall -Wno-unused-imports @@ -133,9 +134,11 @@ QuickCheck , base <5 , cimple + , containers , data-fix , extra , hspec + , mtl , prettyprinter , prettyprinter-ansi-terminal , text diff --git a/src/Language/Cimple/Ast.hs b/src/Language/Cimple/Ast.hs --- a/src/Language/Cimple/Ast.hs +++ b/src/Language/Cimple/Ast.hs @@ -106,7 +106,7 @@ | EnumDecl lexeme [a] lexeme | Enumerator lexeme (Maybe a) | AggregateDecl a - | Typedef a lexeme + | Typedef a lexeme [a] | TypedefFunction a | Struct lexeme [a] | Union lexeme [a] @@ -205,7 +205,7 @@ EnumDecl l as l' -> EnumDecl (f l) (map g as) (f l') Enumerator l ma -> Enumerator (f l) (fmap g ma) AggregateDecl a -> AggregateDecl (g a) - Typedef a l -> Typedef (g a) (f l) + Typedef a l as -> Typedef (g a) (f l) (map g as) TypedefFunction a -> TypedefFunction (g a) Struct l as -> Struct (f l) (map g as) Union l as -> Union (f l) (map g as) diff --git a/src/Language/Cimple/Diagnostics.hs b/src/Language/Cimple/Diagnostics.hs --- a/src/Language/Cimple/Diagnostics.hs +++ b/src/Language/Cimple/Diagnostics.hs @@ -1,18 +1,144 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE Strict #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} module Language.Cimple.Diagnostics - ( Diagnostics + ( DiagnosticLevel (..) + , DiagnosticSpan (..) + , Diagnostic (..) + , IsPosition (..) + , HasDiagnosticInfo (..) + , CimplePos (..) + , DiagnosticsT + , Diagnostics , HasDiagnostics (..) + , HasDiagnosticsRich (..) , warn + , warnRich , sloc + , lexemePos + , nodePos + , nodePosAndLen + , renderPure + , diagToText ) where -import Control.Monad.State.Strict (State) -import qualified Control.Monad.State.Strict as State -import Data.Text (Text) -import Language.Cimple.DescribeAst (HasLocation (..)) +import Control.Monad.State.Strict (State) +import qualified Control.Monad.State.Strict as State +import Data.Fix (foldFix) +import Data.Function (on) +import Data.List (groupBy, sortBy) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Text (Text) +import qualified Data.Text as Text +import Language.Cimple.Ast (Node) +import Language.Cimple.DescribeAst (HasLocation (..)) +import qualified Language.Cimple.Flatten as Flatten +import Language.Cimple.Lexer (AlexPosn (..), Lexeme (..), + lexemeText) +import Prettyprinter (Doc, align, annotate, line, + pretty, vsep, (<+>)) +import qualified Prettyprinter as PP +import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), bold, + color, colorDull) +import qualified Prettyprinter.Render.Text as PP.Text +import qualified Data.ByteString as BS +import qualified Data.Text.Encoding as Text + +data DiagnosticLevel = ErrorLevel | WarningLevel | NoteLevel | HelpLevel + deriving (Show, Eq, Ord) + +data DiagnosticSpan pos = DiagnosticSpan + { spanPos :: pos + , spanLen :: Int + , spanLabels :: [Doc AnsiStyle] + } + +data Diagnostic pos = Diagnostic + { diagPos :: pos + , diagLen :: Int + , diagLevel :: DiagnosticLevel + , diagMsg :: Doc AnsiStyle + , diagFlag :: Maybe Text + , diagSpans :: [DiagnosticSpan pos] + , diagFooter :: [(DiagnosticLevel, Doc AnsiStyle)] + } + +diagToText :: IsPosition pos => Diagnostic pos -> Text +diagToText d = + let p = diagPos d + msg = PP.Text.renderStrict (PP.layoutSmart PP.defaultLayoutOptions (PP.unAnnotate (diagMsg d))) + flag = maybe "" (\f -> " [-W" <> f <> "]") (diagFlag d) + footers = map formatFooter (diagFooter d) + formatFooter (l, footer) = + let pref = case l of + ErrorLevel -> "error: " + WarningLevel -> "warning: " + NoteLevel -> "note: " + HelpLevel -> "help: " + in pref <> PP.Text.renderStrict (PP.layoutSmart PP.defaultLayoutOptions (PP.unAnnotate footer)) + loc = Text.pack (posFile p) <> ":" <> Text.pack (show (posLine p)) <> ": " + level = case diagLevel d of + ErrorLevel -> "error: " + WarningLevel -> "warning: " + NoteLevel -> "note: " + HelpLevel -> "help: " + in Text.intercalate "\n" ( (loc <> level <> msg <> flag) : map (loc <>) footers ) + + +class IsPosition p where + posFile :: p -> FilePath + posLine :: p -> Int + posColumn :: p -> Int + isRealPos :: p -> Bool + isRealPos _ = True + +class IsPosition pos => HasDiagnosticInfo at pos | at -> pos where + getDiagnosticInfo :: FilePath -> at -> (pos, Int) + +data CimplePos = CimplePos + { cimpleFile :: FilePath + , cimpleLine :: Int + , cimpleColumn :: Int + } + deriving (Show, Eq) + +instance IsPosition CimplePos where + posFile = cimpleFile + posLine = cimpleLine + posColumn = cimpleColumn + +instance HasDiagnosticInfo (Lexeme Text) CimplePos where + getDiagnosticInfo file l = (lexemePos file l, Text.length (lexemeText l)) + +instance HasDiagnosticInfo (Node (Lexeme Text)) CimplePos where + getDiagnosticInfo = nodePosAndLen + +lexemePos :: FilePath -> Lexeme text -> CimplePos +lexemePos file (L (AlexPn _ l c) _ _) = CimplePos file l c + +nodePos :: FilePath -> Node (Lexeme text) -> CimplePos +nodePos file n = + case foldFix Flatten.lexemes n of + [] -> CimplePos file 0 0 + l:_ -> lexemePos file l + +nodePosAndLen :: FilePath -> Node (Lexeme Text) -> (CimplePos, Int) +nodePosAndLen file n = + case foldFix Flatten.lexemes n of + [] -> (CimplePos file 0 0, 0) + ls@(l:_) -> + let L (AlexPn start _ _) _ _ = l + L (AlexPn end _ _) _ s = last' ls + in (lexemePos file l, end + Text.length s - start) + where + last' [x] = x + last' (_:xs) = last' xs + last' [] = error "nodePosAndLen: empty list" + type DiagnosticsT diags a = State diags a type Diagnostics a = DiagnosticsT [Text] a @@ -21,9 +147,132 @@ => FilePath -> at -> Text -> DiagnosticsT diags () warn file l w = State.modify (addDiagnostic $ sloc file l <> ": " <> w) +warnRich + :: (HasDiagnosticsRich diags pos) + => Diagnostic pos -> DiagnosticsT diags () +warnRich = State.modify . addDiagnosticRich + class HasDiagnostics a where addDiagnostic :: Text -> a -> a instance HasDiagnostics [Text] where addDiagnostic = (:) + +class HasDiagnosticsRich a pos | a -> pos where + addDiagnosticRich :: Diagnostic pos -> a -> a + +instance HasDiagnosticsRich [Diagnostic pos] pos where + addDiagnosticRich = (:) + + +renderPure :: IsPosition pos => Map FilePath [Text] -> [Diagnostic pos] -> [Doc AnsiStyle] +renderPure cache = map (formatRichError cache) + where + formatRichError cache' (Diagnostic p len level msg flag spans footers) = + vsep $ + [ let msgLines = map (pretty . Text.stripEnd) $ Text.lines (Text.pack (show (PP.unAnnotate msg))) + in case msgLines of + (l:ls) -> header <+> align (vsep ((case flag of + Just f -> l <+> annotate (colorDull White) ("[-W" <> pretty f <> "]") + Nothing -> l) : ls)) + [] -> case flag of + Just f -> header <+> annotate (colorDull White) ("[-W" <> pretty f <> "]") + Nothing -> header + ] ++ + [ annotate (colorDull White) (pretty (replicate (width - 1) ' ') <> "-->") <+> annotate (bold <> color White) (pretty (posFile p) <> ":" <> pretty (posLine p) <> ":" <> pretty (posColumn p)) + | isRealPos p ] ++ + (if null snippet then [] else [annotate (colorDull White) (pretty (replicate width ' ') <> "|")] ++ snippet) ++ + map formatFooter footers + where + header = case level of + ErrorLevel -> annotate (color Red <> bold) "error:" + WarningLevel -> annotate (color Yellow <> bold) "warning:" + NoteLevel -> annotate (color Cyan <> bold) "note:" + HelpLevel -> annotate (color Green <> bold) "help:" + + spansToShow = + let primary = DiagnosticSpan p len [] + samePos s1 s2 = isRealPos s1 && isRealPos s2 && posFile s1 == posFile s2 && posLine s1 == posLine s2 && posColumn s1 == posColumn s2 + in if isRealPos p && all (\s -> not (samePos (spanPos s) p)) spans + then primary : spans + else spans + + width = + let lineNums = [posLine (spanPos s) | s <- spansToShow, isRealPos (spanPos s)] + maxLine = if null lineNums then 0 else maximum lineNums + in max 4 (length (show maxLine)) + + groupedSpans = groupBy ((==) `on` (posLine . spanPos)) $ sortBy (compare `on` (posLine . spanPos)) spansToShow + snippet = concatMap renderGrouped groupedSpans + + formatFooter (l, d) = + let pref = case l of + ErrorLevel -> annotate (color Red <> bold) " = error:" + WarningLevel -> annotate (color Yellow <> bold) " = warning:" + NoteLevel -> annotate (color Cyan <> bold) " = note:" + HelpLevel -> annotate (color Green <> bold) " = help:" + in pref <+> align d + + renderGrouped ss@(DiagnosticSpan sp _ _ : _) = + let mFileLines = if isRealPos sp then Map.lookup (posFile sp) cache' else Nothing + row = posLine sp + rowStr = show row + gutterStr = replicate (max 0 (width - length rowStr)) ' ' ++ rowStr ++ "|" + gutter = pretty gutterStr + lineText = case mFileLines of + Just fileLines | row > 0 && row <= length fileLines -> + [gutter <+> pretty (expandTabs 8 (fileLines !! (row - 1)))] + _ -> [] + -- Group spans on the same line by position and merge labels + uniqueSpans = map mergeLabels . groupBy ((==) `on` posAndLen') . sortBy (compare `on` posAndLen') $ ss + posAndLen' (DiagnosticSpan s le _) = (posColumn s, le) + mergeLabels [] = error "mergeLabels: empty group" + mergeLabels (DiagnosticSpan s le labels : samePosSpans) = + let allLabels = labels ++ concatMap spanLabels samePosSpans + in DiagnosticSpan s le allLabels + + sourceLine = case mFileLines of + Just fileLines | row > 0 && row <= length fileLines -> fileLines !! (row - 1) + _ -> "" + in lineText ++ concatMap (renderSp sourceLine) uniqueSpans + renderGrouped [] = [] + + renderSp sourceLine (DiagnosticSpan sp l labels) = + let col = posColumn sp + -- 'col' is 1-based byte offset. + -- We need to find how many characters are before this byte offset. + charCol = byteToCharOffset sourceLine (col - 1) + -- Extract the prefix up to that character offset. + prefix = Text.take charCol sourceLine + -- Calculate visual width of that prefix (handling tabs). + visualCol = Text.length (expandTabs 8 prefix) + + -- Calculate visual width of the span. + spanText = Text.take (byteToCharOffset (Text.drop charCol sourceLine) l) (Text.drop charCol sourceLine) + visualLen = Text.length (expandTabs 8 spanText) + + padding = replicate visualCol ' ' + underline = annotate (color Red <> bold) (pretty padding <> pretty (replicate (max 1 visualLen) '^')) + labelDocs = map (\lab -> line <> pretty (replicate width ' ') <> "|" <+> pretty padding <> align lab) labels + fullLabel = if null labels + then mempty + else line <> pretty (replicate width ' ') <> "|" <+> pretty padding <> "|" <> mconcat labelDocs + in [ pretty (replicate width ' ') <> "|" <+> underline <> fullLabel ] + +expandTabs :: Int -> Text -> Text +expandTabs tabWidth = Text.pack . go 0 . Text.unpack + where + go _ [] = [] + go col (c:cs) + | c == '\t' = + let spaces = tabWidth - (col `mod` tabWidth) + in replicate spaces ' ' ++ go (col + spaces) cs + | otherwise = c : go (col + 1) cs + +byteToCharOffset :: Text -> Int -> Int +byteToCharOffset t byteOffset = + let bs = Text.encodeUtf8 t + in if byteOffset >= BS.length bs + then Text.length t + else Text.length (Text.decodeUtf8 (BS.take byteOffset bs)) diff --git a/src/Language/Cimple/Lexer.x b/src/Language/Cimple/Lexer.x --- a/src/Language/Cimple/Lexer.x +++ b/src/Language/Cimple/Lexer.x @@ -43,6 +43,28 @@ %wrapper "monadUserState-bytestring" +$digit = [0-9] +$alpha = [a-zA-Z] +$upper = [A-Z] +$lower = [a-z] + +@alphanum = $alpha | $digit +@alphanum_ = $alpha | $digit | \_ + +@ident_upper = $upper ($upper | $digit | \_)* +@ident_lower = $lower ($lower | $digit | \_)* + +@upper_snake = $upper ($upper | $digit)* \_ ($upper | $digit | \_)* +@lower_snake = $lower ($lower | $digit)* \_ ($lower | $digit | \_)* +@pascal_case = $upper @alphanum_* $lower @alphanum_* +@camel_case = $lower @alphanum_* $upper @alphanum_* + +@win_type_prefix = WSA (EVENT | DATA) | LP (STR | TSTR | SOCKADDR) +@win_type_suffix = $upper @alphanum* (INFO | DATA | PARAMS | HEADER | STRUCT | UNION | INTEGER | TIME | STATUS | EVENT) +@win_type_extra = IP_ADAPTER_INFO | LARGE_INTEGER | ULARGE_INTEGER +@win_type_common = DWORD | WORD | BYTE | BOOL | SOCKET | INT | UINT | LONG | ULONG | SHORT | USHORT | CHAR | UCHAR | FILETIME | HANDLE | LONGLONG +@win_type = @win_type_prefix | @win_type_suffix | @win_type_extra | @win_type_common | u_long | u_int | u_short | u_char + tokens :- -- Ignore attributes. @@ -50,20 +72,14 @@ <0> "VLA" { mkL KwVla } -- Winapi functions. -<0> "FormatMessageA" { mkL IdVar } -<0> "GetAdaptersInfo" { mkL IdVar } -<0> "GetSystemTimeAsFileTime" { mkL IdVar } -<0> "GetTickCount" { mkL IdVar } -<0> "LocalFree" { mkL IdVar } -<0> "QueryPerformanceCounter" { mkL IdVar } -<0> "QueryPerformanceFrequency" { mkL IdVar } +<0> "Device" @pascal_case { mkL IdVar } +<0> "FormatMessage" [AW]? { mkL IdVar } +<0> "Get" @pascal_case { mkL IdVar } +<0> ("Local"|"Heap") ("Alloc"|"Free") { mkL IdVar } +<0> "Query" @pascal_case { mkL IdVar } <0> "SecureZeroMemory" { mkL IdVar } -<0> "WSAAddressToString"("A"?) { mkL IdVar } -<0> "WSACleanup" { mkL IdVar } -<0> "WSAGetLastError" { mkL IdVar } -<0> "WSASetLastError" { mkL IdVar } -<0> "WSAStartup" { mkL IdVar } -<0> "WSAStringToAddress"("A"?) { mkL IdVar } +<0> "Sleep" { mkL IdVar } +<0> "WSA" @pascal_case { mkL IdVar } -- Winapi struct members. <0> "GatewayList" { mkL IdVar } @@ -75,17 +91,7 @@ <0> "String" { mkL IdVar } -- Windows typedefs. -<0> "DWORD" { mkL IdStdType } -<0> "FILETIME" { mkL IdStdType } -<0> "INT" { mkL IdStdType } -<0> "LPSOCKADDR" { mkL IdStdType } -<0> "IP_ADAPTER_INFO" { mkL IdStdType } -<0> "LPSTR" { mkL IdStdType } -<0> "LPTSTR" { mkL IdStdType } -<0> "u_long" { mkL IdStdType } -<0> "LARGE_INTEGER" { mkL IdStdType } -<0> "SOCKET" { mkL IdStdType } -<0> "WSADATA" { mkL IdStdType } +<0,ppSC> @win_type { mkL IdStdType } -- System struct types. <0> "addrinfo" { mkL IdSueType } @@ -99,34 +105,11 @@ <0> "in_addr" { mkL IdSueType } <0> "in6_addr" { mkL IdSueType } <0> "ipv6_mreq" { mkL IdSueType } -<0> "sockaddr" { mkL IdSueType } -<0> "sockaddr_in" { mkL IdSueType } -<0> "sockaddr_in6" { mkL IdSueType } -<0> "sockaddr_storage" { mkL IdSueType } +<0> "pollfd" { mkL IdSueType } +<0> "sockaddr"("_in"|"_in6"|"_storage")? { mkL IdSueType } <0> "timespec" { mkL IdSueType } <0> "timeval" { mkL IdSueType } --- Msgpack struct types. -<0> "msgpack_iovec" { mkL IdSueType } -<0> "msgpack_object_array" { mkL IdSueType } -<0> "msgpack_object_bin" { mkL IdSueType } -<0> "msgpack_object_ext" { mkL IdSueType } -<0> "msgpack_object_kv" { mkL IdSueType } -<0> "msgpack_object_map" { mkL IdSueType } -<0> "msgpack_object" { mkL IdSueType } -<0> "msgpack_object_str" { mkL IdSueType } -<0> "msgpack_object_type" { mkL IdSueType } -<0> "msgpack_packer" { mkL IdSueType } -<0> "msgpack_packer_write" { mkL IdFuncType } -<0> "msgpack_sbuffer" { mkL IdSueType } -<0> "msgpack_timestamp" { mkL IdSueType } -<0> "msgpack_unpacked" { mkL IdSueType } -<0> "msgpack_unpacker" { mkL IdSueType } -<0> "msgpack_unpack_return" { mkL IdSueType } -<0> "msgpack_vrefbuffer" { mkL IdSueType } -<0> "msgpack_zbuffer" { mkL IdSueType } -<0> "msgpack_zone" { mkL IdSueType } - -- Sodium types. <0> "crypto_generichash_blake2b_state" { mkL IdSueType } @@ -207,6 +190,7 @@ <0,ppSC> "long int" { mkL IdStdType } <0,ppSC> "long signed int" { mkL IdStdType } <0,ppSC> "long" { mkL IdStdType } +<0,ppSC> "long long" { mkL IdStdType } <0,ppSC> "signed int" { mkL IdStdType } <0,ppSC> "unsigned int" { mkL IdStdType } <0,ppSC> "unsigned long" { mkL IdStdType } @@ -217,15 +201,18 @@ <0,ppSC> "true" { mkL LitTrue } <0,ppSC> "__func__" { mkL IdVar } <0,ppSC> "nullptr" { mkL IdConst } -<0,ppSC> "__"[a-zA-Z]+"__"? { mkL IdConst } -<0,ppSC> [A-Z][A-Z0-9_]{1,2} { mkL IdSueType } -<0,ppSC> _*[A-Z][A-Z0-9_]* { mkL IdConst } -<0,ppSC> [A-Z][A-Za-z0-9_]*[a-z][A-Za-z0-9_]* { mkL IdSueType } -<0,ppSC> "cmp_"[a-z][a-z0-9_]*_[suet] { mkL IdSueType } -<0,ppSC> [a-z][a-z0-9_]*_t { mkL IdStdType } -<0,ppSC> [a-z][a-z0-9_]*_cb { mkL IdFuncType } -<0,ppSC> "cmp_"("reader"|"writer"|"skipper") { mkL IdFuncType } -<0,ppSC> [a-z][A-Za-z0-9_]* { mkL IdVar } +<0,ppSC> "nullptr" { mkL IdConst } +<0,ppSC> "__" @alphanum_+ "__"? { mkL IdConst } +<0,ppSC> "_" @ident_upper { mkL IdConst } +<0,ppSC> $upper ($upper | $digit | \_){1,2} { mkL IdSueType } +<0,ppSC> @ident_upper { mkL IdConst } +<0,ppSC> @pascal_case { mkL IdSueType } +<0,ppSC> "cmp_" @ident_lower "_" [suet] { mkL IdSueType } +<0,ppSC> @ident_lower "_t" { mkL IdStdType } +<0,ppSC> @ident_lower "_cb" { mkL IdFuncType } +<0,ppSC> "cmp_" ("reader"|"writer"|"skipper") { mkL IdFuncType } +<0,ppSC> @camel_case { mkL IdVar } +<0,ppSC> @ident_lower { mkL IdVar } <0,ppSC,cmtSC> [0-9]+[LU]* { mkL LitInteger } <0,ppSC,cmtSC> [0-9]+"."[0-9]+[Ff]? { mkL LitFloat } <0,ppSC> 0x[0-9a-fA-F]+[LU]* { mkL LitInteger } diff --git a/src/Language/Cimple/MapAst.hs b/src/Language/Cimple/MapAst.hs --- a/src/Language/Cimple/MapAst.hs +++ b/src/Language/Cimple/MapAst.hs @@ -297,8 +297,8 @@ Fix <$> (Enumerator <$> recurse name <*> recurse value) AggregateDecl struct -> Fix <$> (AggregateDecl <$> recurse struct) - Typedef ty name -> - Fix <$> (Typedef <$> recurse ty <*> recurse name) + Typedef ty name arrs -> + Fix <$> (Typedef <$> recurse ty <*> recurse name <*> recurse arrs) TypedefFunction ty -> Fix <$> (TypedefFunction <$> recurse ty) Struct name members -> diff --git a/src/Language/Cimple/Parser.y b/src/Language/Cimple/Parser.y --- a/src/Language/Cimple/Parser.y +++ b/src/Language/Cimple/Parser.y @@ -26,8 +26,7 @@ import Language.Cimple.Tokens (LexemeClass (..)) } --- Conflict between (static) FunctionDecl and (static) ConstDecl. -%expect 2 +%expect 0 %name parseTranslationUnit TranslationUnit %name parseExpr Expr @@ -290,8 +289,8 @@ | IgnoreBody IGN_BODY { $2 : $1 } PreprocIfdef(decls) -: '#ifdef' ID_CONST decls PreprocElse(decls) Endif { Fix $ PreprocIfdef $2 (reverse $3) $4 } -| '#ifndef' ID_CONST decls PreprocElse(decls) Endif { Fix $ PreprocIfndef $2 (reverse $3) $4 } +: '#ifdef' ID_CONST decls PreprocElif(decls) Endif { Fix $ PreprocIfdef $2 (reverse $3) $4 } +| '#ifndef' ID_CONST decls PreprocElif(decls) Endif { Fix $ PreprocIfndef $2 (reverse $3) $4 } PreprocIf(decls) : '#if' PreprocConstExpr '\n' decls PreprocElif(decls) Endif { Fix $ PreprocIf $2 (reverse $4) $5 } @@ -661,7 +660,7 @@ AggregateDecl :: { NonTerm } AggregateDecl : AggregateType ';' { Fix $ AggregateDecl $1 } -| typedef AggregateType ID_SUE_TYPE ';' { Fix $ Typedef $2 $3 } +| typedef AggregateType ID_SUE_TYPE ';' { Fix $ Typedef $2 $3 [] } AggregateType :: { NonTerm } AggregateType @@ -686,9 +685,9 @@ TypedefDecl :: { NonTerm } TypedefDecl -: typedef QualType(GlobalLeafType) ID_SUE_TYPE ';' { Fix $ Typedef $2 $3 } +: typedef QualType(GlobalLeafType) ID_SUE_TYPE DeclSpecArrays ';' { Fix $ Typedef $2 $3 $4 } | typedef FunctionPrototype(ID_FUNC_TYPE) ';' { Fix $ TypedefFunction $2 } -| struct ID_SUE_TYPE ';' { Fix $ Typedef (Fix (TyStruct $2)) $2 } +| struct ID_SUE_TYPE ';' { Fix $ Typedef (Fix (TyStruct $2)) $2 [] } QualType(leafType) : bitwise ID_STD_TYPE { Fix (TyBitwise (Fix (TyStd $2))) } @@ -784,9 +783,9 @@ ConstDecl :: { NonTerm } ConstDecl -: extern const GlobalLeafType ID_VAR ';' { Fix $ ConstDecl $3 $4 } -| const GlobalLeafType ID_VAR '=' InitialiserExpr ';' { Fix $ ConstDefn Global $2 $3 $5 } -| static const GlobalLeafType ID_VAR '=' InitialiserExpr ';' { Fix $ ConstDefn Static $3 $4 $6 } +: extern QualType(GlobalLeafType) ID_VAR ';' { Fix $ ConstDecl $2 $3 } +| QualType(GlobalLeafType) ID_VAR '=' InitialiserExpr ';' { Fix $ ConstDefn Global $1 $2 $4 } +| static QualType(GlobalLeafType) ID_VAR '=' InitialiserExpr ';' { Fix $ ConstDefn Static $2 $3 $5 } { type Term = Lexeme Text diff --git a/src/Language/Cimple/Parser/Error/Pretty.hs b/src/Language/Cimple/Parser/Error/Pretty.hs --- a/src/Language/Cimple/Parser/Error/Pretty.hs +++ b/src/Language/Cimple/Parser/Error/Pretty.hs @@ -167,6 +167,7 @@ | ["ID_CONST", "sizeof", "LIT_CHAR", "LIT_FALSE", "LIT_INTEGER"] `isPrefixOf` options = "constant expression" | ["ID_CONST", "ID_SUE_TYPE", "'/*'" ] `isPrefixOf` options = "enumerator, type name, or comment" | wants ["'defined'"] = "preprocessor constant expression" + | wants ["ID_CONST", "sizeof", "LIT_CHAR", "LIT_FLOAT", "LIT_FALSE", "LIT_TRUE", "LIT_INTEGER", "LIT_STRING", "'('", "'\\n'"] = "macro body" | wants ["'&'", "'&&'", "'*'", "'=='", "';'"] = "operator or end of statement" | wants ["'&'", "'&&'", "'*'", "'^'", "'!='"] = "operator" | wants ["ID_CONST", "ID_VAR", "LIT_CHAR", "'*'", "'('"] = "expression" @@ -175,6 +176,7 @@ | ["'&='", "'->'", "'*='"] `isPrefixOf` options = "assignment or member/array access" | wants ["'='", "'*='", "'/='", "'+='", "'-='"] = "assignment operator" | wants ["CMT_WORD"] = "comment contents" + | wants ["','", "'}'", "'/*'"] = "',' or closing brace (or a comment)" | length options == 2 = commaOr options | otherwise = "one of " <> commaOr options diff --git a/src/Language/Cimple/Pretty.hs b/src/Language/Cimple/Pretty.hs --- a/src/Language/Cimple/Pretty.hs +++ b/src/Language/Cimple/Pretty.hs @@ -351,15 +351,15 @@ kwUnion <+> ppLexeme name <+> lbrace <> line <> vcat members ) <> line <> rbrace - Typedef ty tyname -> - kwTypedef <+> ty <+> dullgreen (ppLexeme tyname) <> semi + Typedef ty tyname arrs -> + kwTypedef <+> ty <+> dullgreen (ppLexeme tyname) <> hcat arrs <> semi TypedefFunction proto -> kwTypedef <+> proto <> semi ConstDecl ty name -> - kwExtern <+> kwConst <+> ty <+> ppLexeme name <> semi + kwExtern <+> ty <+> ppLexeme name <> semi ConstDefn scope ty name value -> - ppScope scope <> kwConst <+> + ppScope scope <> ty <+> ppLexeme name <+> equals <+> value <> semi Enumerator name Nothing -> ppLexeme name <> comma diff --git a/src/Language/Cimple/TraverseAst.hs b/src/Language/Cimple/TraverseAst.hs --- a/src/Language/Cimple/TraverseAst.hs +++ b/src/Language/Cimple/TraverseAst.hs @@ -377,9 +377,10 @@ AggregateDecl struct -> do _ <- recurse struct pure () - Typedef ty name -> do + Typedef ty name arrs -> do _ <- recurse ty _ <- recurse name + _ <- recurse arrs pure () TypedefFunction ty -> recurse ty diff --git a/src/Language/Cimple/TreeParser.y b/src/Language/Cimple/TreeParser.y --- a/src/Language/Cimple/TreeParser.y +++ b/src/Language/Cimple/TreeParser.y @@ -105,7 +105,7 @@ enumerator { Fix (Enumerator{}) } aggregateDecl { Fix (AggregateDecl{}) } typedefFunction { Fix (TypedefFunction{}) } - typedefStruct { Fix (Typedef (Fix Struct{}) _) } + typedefStruct { Fix (Typedef (Fix Struct{}) _ _) } typedef { Fix (Typedef{}) } struct { Fix (Struct{}) } union { Fix (Union{}) } @@ -253,9 +253,9 @@ processAggregate (Fix (AggregateDecl agg)) = do processedAgg <- processAggregate agg return $ Fix (AggregateDecl processedAgg) -processAggregate (Fix (Typedef agg name)) = do +processAggregate (Fix (Typedef agg name arrs)) = do processedAgg <- processAggregate agg - return $ Fix (Typedef processedAgg name) + return $ Fix (Typedef processedAgg name arrs) processAggregate n = return n -- Return other types unchanged recurse :: ([NonTerm] -> ParseResult [NonTerm]) -> NonTerm -> ParseResult NonTerm diff --git a/test/Language/Cimple/AstSpec.hs b/test/Language/Cimple/AstSpec.hs --- a/test/Language/Cimple/AstSpec.hs +++ b/test/Language/Cimple/AstSpec.hs @@ -29,7 +29,8 @@ Fix (Compose (Annot () ( ConstDefn Global (Fix (Compose (Annot () ( - TyStd (L (AlexPn 6 1 7) IdStdType "int"))))) + TyConst (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")))))))) @@ -38,7 +39,7 @@ addAnnot ast `shouldSatisfy` \case (removeAnnot -> Fix (ConstDefn Global - (Fix (TyStd (L (AlexPn 6 1 7) IdStdType "int"))) + (Fix (TyConst (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 @@ -126,7 +127,7 @@ test (EnumDecl "l" ["as"] "l'") (EnumDecl "l-l" ["a-as"] "l-l'") test (Enumerator "l" (Just "ma")) (Enumerator "l-l" (Just "a-ma")) test (AggregateDecl "a") (AggregateDecl "a-a") - test (Typedef "a" "l") (Typedef "a-a" "l-l") + test (Typedef "a" "l" ["as"]) (Typedef "a-a" "l-l" ["a-as"]) test (TypedefFunction "a") (TypedefFunction "a-a") test (Struct "l" ["as"]) (Struct "l-l" ["a-as"]) test (Union "l" ["as"]) (Union "l-l" ["a-as"]) diff --git a/test/Language/Cimple/DiagnosticsSpec.hs b/test/Language/Cimple/DiagnosticsSpec.hs new file mode 100644 --- /dev/null +++ b/test/Language/Cimple/DiagnosticsSpec.hs @@ -0,0 +1,400 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +module Language.Cimple.DiagnosticsSpec where + +import qualified Control.Monad.State.Strict as State +import Data.Fix (Fix (..)) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Text (Text) +import qualified Data.Text as Text +import GHC.Stack (HasCallStack) +import Language.Cimple (AlexPosn (..), BinaryOp (..), + Lexeme (..), LexemeClass (..), + NodeF (..)) +import Language.Cimple.Diagnostics +import Prettyprinter (Doc, LayoutOptions (..), + PageWidth (..), + defaultLayoutOptions, + layoutPretty, vsep) +import Prettyprinter.Render.Text (renderStrict) +import Test.Hspec + +spec :: Spec +spec = do + describe "nodePosAndLen" $ do + it "calculates position and length of a simple node" $ do + let lexeme = L (AlexPn 10 2 5) IdVar "var" + let node = Fix (VarExpr lexeme) + let (pos, len) = nodePosAndLen "test.c" node + pos `shouldBe` CimplePos "test.c" 2 5 + len `shouldBe` 3 + + it "calculates position and length of a complex node" $ do + let l1 = L (AlexPn 10 2 5) IdVar "x" + -- l2 (operator) is skipped in flattening if not in the node structure as a child + let l3 = L (AlexPn 30 2 25) IdVar "y" + -- FunctionCall contains the function name and args, so it covers l1 to l3 + let node = Fix (FunctionCall (Fix (VarExpr l1)) [Fix (VarExpr l3)]) + let (pos, len) = nodePosAndLen "test.c" node + pos `shouldBe` CimplePos "test.c" 2 5 + -- Length is from start of l1 (10) to end of l3 (30 + 1). 31 - 10 = 21. + len `shouldBe` 21 + + describe "Diagnostics State" $ do + it "warn collects diagnostics" $ do + let lexeme = L (AlexPn 0 1 1) IdVar ("foo" :: Text) + let action = warn "test.c" lexeme "warning message" + let diags = State.execState action [] :: [Text] + diags `shouldBe` ["test.c:1: warning message"] + + it "warnRich collects rich diagnostics" $ do + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1 1 + , diagLen = 5 + , diagLevel = WarningLevel + , diagMsg = "warning message" + , diagFlag = Just "some-flag" + , diagSpans = [] + , diagFooter = [] + } + let action = warnRich diag + let diags = State.execState action [] + case diags of + [d] -> do + diagLevel d `shouldBe` WarningLevel + diagFlag d `shouldBe` Just "some-flag" + _ -> expectationFailure "Expected exactly one diagnostic" + + describe "renderPure" $ do + it "renders different levels" $ do + let mkDiag lvl msg = Diagnostic + { diagPos = CimplePos "test.c" 1 1 + , diagLen = 1 + , diagLevel = lvl + , diagMsg = msg + , diagFlag = Nothing + , diagSpans = [] + , diagFooter = [] + } + shouldRenderTo mempty [mkDiag WarningLevel "warn"] + [ "warning: warn" + , " --> test.c:1:1" + , " |" + , " | ^" + ] + shouldRenderTo mempty [mkDiag NoteLevel "note"] + [ "note: note" + , " --> test.c:1:1" + , " |" + , " | ^" + ] + shouldRenderTo mempty [mkDiag HelpLevel "help"] + [ "help: help" + , " --> test.c:1:1" + , " |" + , " | ^" + ] + + it "renders flags" $ do + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1 1 + , diagLen = 1 + , diagLevel = WarningLevel + , diagMsg = "some warning" + , diagFlag = Just "my-check" + , diagSpans = [] + , diagFooter = [] + } + shouldRenderTo mempty [diag] + [ "warning: some warning [-Wmy-check]" + , " --> test.c:1:1" + , " |" + , " | ^" + ] + + it "renders multiline messages" $ do + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1 1 + , diagLen = 1 + , diagLevel = ErrorLevel + , diagMsg = "line 1\nline 2" + , diagFlag = Nothing + , diagSpans = [] + , diagFooter = [] + } + shouldRenderTo mempty [diag] + [ "error: line 1" + , " line 2" + , " --> test.c:1:1" + , " |" + , " | ^" + ] + + it "renders line numbers > 1000 correctly" $ do + let dummyLines = replicate 999 "..." ++ ["target line"] + let cache = Map.fromList [("test.c", dummyLines)] + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1000 1 + , diagLen = 6 + , diagLevel = ErrorLevel + , diagMsg = "msg" + , diagFlag = Nothing + , diagSpans = [] + , diagFooter = [] + } + shouldRenderTo cache [diag] + [ "error: msg" + , " --> test.c:1000:1" + , " |" + , "1000| target line" + , " | ^^^^^^" + ] + + it "renders line numbers > 10000 correctly" $ do + let dummyLines = replicate 9999 "..." ++ ["target line"] + let cache = Map.fromList [("test.c", dummyLines)] + let diag = Diagnostic + { diagPos = CimplePos "test.c" 10000 1 + , diagLen = 6 + , diagLevel = ErrorLevel + , diagMsg = "msg" + , diagFlag = Nothing + , diagSpans = [] + , diagFooter = [] + } + shouldRenderTo cache [diag] + [ "error: msg" + , " --> test.c:10000:1" + , " |" + , "10000| target line" + , " | ^^^^^^" + ] + + it "renders a simple error without source context" $ do + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1 1 + , diagLen = 5 + , diagLevel = ErrorLevel + , diagMsg = "something went wrong" + , diagFlag = Nothing + , diagSpans = [] + , diagFooter = [] + } + shouldRenderTo mempty [diag] + [ "error: something went wrong" + , " --> test.c:1:1" + , " |" + , " | ^" + ] + + it "renders an error with source context" $ do + let source = "int x = ;" + let cache = Map.fromList [("test.c", [source])] + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1 9 + , diagLen = 1 + , diagLevel = ErrorLevel + , diagMsg = "expected expression" + , diagFlag = Nothing + , diagSpans = [] + , diagFooter = [] + } + shouldRenderTo cache [diag] + [ "error: expected expression" + , " --> test.c:1:9" + , " |" + , " 1| int x = ;" + , " | ^" + ] + + it "renders an error with multiple spans" $ do + let source = "int x = y + z;" + let cache = Map.fromList [("test.c", [source])] + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1 9 + , diagLen = 1 + , diagLevel = ErrorLevel + , diagMsg = "type mismatch" + , diagFlag = Nothing + , diagSpans = + [ DiagnosticSpan (CimplePos "test.c" 1 9) 1 ["this is int"] + , DiagnosticSpan (CimplePos "test.c" 1 13) 1 ["this is float"] + ] + , diagFooter = [] + } + shouldRenderTo cache [diag] + [ "error: type mismatch" + , " --> test.c:1:9" + , " |" + , " 1| int x = y + z;" + , " | ^" + , " | |" + , " | this is int" + , " | ^" + , " | |" + , " | this is float" + ] + + it "renders footers" $ do + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1 1 + , diagLen = 1 + , diagLevel = ErrorLevel + , diagMsg = "bad thing" + , diagFlag = Nothing + , diagSpans = [] + , diagFooter = [(NoteLevel, "did you mean something else?")] + } + shouldRenderTo mempty [diag] + [ "error: bad thing" + , " --> test.c:1:1" + , " |" + , " | ^" + , " = note: did you mean something else?" + ] + + it "renders multiple spans on different lines" $ do + let source = ["int x = 1;", "int y = 2;", "x + y;"] + let cache = Map.fromList [("test.c", source)] + let diag = Diagnostic + { diagPos = CimplePos "test.c" 3 1 + , diagLen = 5 + , diagLevel = ErrorLevel + , diagMsg = "error here" + , diagFlag = Nothing + , diagSpans = + [ DiagnosticSpan (CimplePos "test.c" 1 5) 1 ["decl 1"] + , DiagnosticSpan (CimplePos "test.c" 2 5) 1 ["decl 2"] + , DiagnosticSpan (CimplePos "test.c" 3 1) 5 ["usage"] + ] + , diagFooter = [] + } + shouldRenderTo cache [diag] + [ "error: error here" + , " --> test.c:3:1" + , " |" + , " 1| int x = 1;" + , " | ^" + , " | |" + , " | decl 1" + , " 2| int y = 2;" + , " | ^" + , " | |" + , " | decl 2" + , " 3| x + y;" + , " | ^^^^^" + , " | |" + , " | usage" + ] + + it "includes implicit primary span if not present in spans" $ do + let source = "int x;" + let cache = Map.fromList [("test.c", [source])] + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1 5 + , diagLen = 1 + , diagLevel = ErrorLevel + , diagMsg = "error" + , diagFlag = Nothing + , diagSpans = + [ DiagnosticSpan (CimplePos "test.c" 1 1) 3 ["type"] + ] + , diagFooter = [] + } + shouldRenderTo cache [diag] + [ "error: error" + , " --> test.c:1:5" + , " |" + , " 1| int x;" + , " | ^^^" + , " | |" + , " | type" + , " | ^" + ] + + describe "diagToText" $ do + it "converts diagnostic to simple text format" $ do + let diag = Diagnostic + { diagPos = CimplePos "test.c" 10 5 + , diagLen = 3 + , diagLevel = WarningLevel + , diagMsg = "something fishy" + , diagFlag = Just "checks" + , diagSpans = [] + , diagFooter = [(NoteLevel, "check it out")] + } + let text = diagToText diag + text `shouldBe` "test.c:10: warning: something fishy [-Wchecks]\ntest.c:10: note: check it out" + + describe "tab expansion" $ do + it "expands tabs in source line for alignment" $ do + -- Source: "abc\tvar" + -- 'a' at 1, 'b' at 2, 'c' at 3. + -- '\t' at 4. Moves cursor to next multiple of 8 + 1 => 9. + -- "var" starts at byte 5. + -- Visual position of "var" is 9. + let source = "abc\tvar" + let cache = Map.fromList [("test.c", [source])] + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1 5 + , diagLen = 3 + , diagLevel = ErrorLevel + , diagMsg = "found var" + , diagFlag = Nothing + , diagSpans = [] + , diagFooter = [] + } + -- Expectation: + -- Source line should have tab expanded to 5 spaces (3 chars + 5 spaces = 8). + -- "abc var" + -- 123456789 + -- ^ + shouldRenderTo cache [diag] + [ "error: found var" + , " --> test.c:1:5" + , " |" + , " 1| abc var" + , " | ^^^" + ] + + it "handles multi-byte characters correctly" $ do + -- Source: "/* é */ int x;" + -- 'é' is 2 bytes (C3 A9). + -- "/* " is 3 bytes. + -- "é" is 2 bytes. + -- " */ " is 4 bytes. + -- Total bytes before 'int': 3 + 2 + 4 = 9 bytes. + -- 'int' starts at byte 10. + -- Visual: "/* é */ int x;" + -- "/* " (3 cols) + -- "é" (1 col) + -- " */ " (4 cols) + -- Total visual cols: 3 + 1 + 4 = 8 cols. + -- 'int' starts at visual col 9. + let source = "/* é */ int x;" + let cache = Map.fromList [("test.c", [source])] + let diag = Diagnostic + { diagPos = CimplePos "test.c" 1 10 + , diagLen = 3 + , diagLevel = ErrorLevel + , diagMsg = "found int" + , diagFlag = Nothing + , diagSpans = [] + , diagFooter = [] + } + shouldRenderTo cache [diag] + [ "error: found int" + , " --> test.c:1:10" + , " |" + , " 1| /* é */ int x;" + , " | ^^^" + ] + +shouldRenderTo :: HasCallStack => Map FilePath [Text] -> [Diagnostic CimplePos] -> [Text] -> Expectation +shouldRenderTo cache diags expected = + let docs = renderPure cache diags + opts = defaultLayoutOptions { layoutPageWidth = Unbounded } + rendered = renderStrict $ layoutPretty opts (vsep docs) + actualLines = map Text.stripEnd $ Text.lines rendered + in actualLines `shouldBe` expected diff --git a/test/Language/Cimple/ParserSpec.hs b/test/Language/Cimple/ParserSpec.hs --- a/test/Language/Cimple/ParserSpec.hs +++ b/test/Language/Cimple/ParserSpec.hs @@ -34,6 +34,10 @@ let ast = parseText "int a(void) { return 3; }" ast `shouldSatisfy` isRight1 + it "should parse a const function declaration" $ do + let ast = parseText "const int f(void);" + ast `shouldSatisfy` isRight1 + it "should parse dereferencing a function pointer" $ do let ast = parseText "void f() { struct My_Struct s_var = *get_s(1); }" ast `shouldSatisfy` isRight1 @@ -66,6 +70,70 @@ , " int y;" , "};" ] + ast `shouldSatisfy` isRight1 + + it "should parse a typedef with an array" $ do + let ast = parseText "typedef uint8_t Public_Key[32];" + ast `shouldSatisfy` isRight1 + + it "should parse #ifdef/#elif" $ do + let ast = parseText $ Text.unlines + [ "struct Foo {" + , " int x;" + , "#ifdef HAVE_FOO_BAR" + , " int foo_bar;" + , "#elif defined(HAVE_BAR_FOO)" + , " int bar_foo;" + , "#endif /* HAVE_FOO_BAR */" + , " int y;" + , "};" + ] + ast `shouldSatisfy` isRight1 + + it "should parse #ifndef/#elif" $ do + let ast = parseText $ Text.unlines + [ "struct Foo {" + , " int x;" + , "#ifndef HAVE_FOO_BAR" + , " int foo_bar;" + , "#elif defined(HAVE_BAR_FOO)" + , " int bar_foo;" + , "#endif /* HAVE_FOO_BAR */" + , " int y;" + , "};" + ] + ast `shouldSatisfy` isRight1 + + it "should parse LOGGER_INFO as a constant" $ do + let ast = parseText "void f() { int x = LOGGER_INFO; }" + ast `shouldSatisfy` isRight1 + + it "should parse IP_ADAPTER_INFO as a type" $ do + let ast = parseText "void f() { IP_ADAPTER_INFO *x; }" + ast `shouldSatisfy` isRight1 + + it "should parse LARGE_INTEGER as a type" $ do + let ast = parseText "void f() { LARGE_INTEGER x; }" + ast `shouldSatisfy` isRight1 + + it "should parse POLLIN as a constant" $ do + let ast = parseText "void f() { int x = POLLIN; }" + ast `shouldSatisfy` isRight1 + + it "should parse WSAEWOULDBLOCK as a constant" $ do + let ast = parseText "void f() { int x = WSAEWOULDBLOCK; }" + ast `shouldSatisfy` isRight1 + + it "should parse WSADATA as a type" $ do + let ast = parseText "void f() { WSADATA wsaData; }" + ast `shouldSatisfy` isRight1 + + it "should parse DHT as a type" $ do + let ast = parseText "void f() { DHT *dht; }" + ast `shouldSatisfy` isRight1 + + it "should parse _WIN32 as a constant" $ do + let ast = parseText "void f() { int x = _WIN32; }" ast `shouldSatisfy` isRight1 it "should parse a comment" $ do diff --git a/test/Language/Cimple/PrettyCommentSpec.hs b/test/Language/Cimple/PrettyCommentSpec.hs --- a/test/Language/Cimple/PrettyCommentSpec.hs +++ b/test/Language/Cimple/PrettyCommentSpec.hs @@ -45,13 +45,13 @@ [ "/**" , " * @brief hello world." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @brief hello world." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print a doc comment with a paragraph" $ @@ -61,7 +61,7 @@ , " *" , " * There's more to say about today." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" @@ -69,7 +69,7 @@ , " *" , " * There's more to say about today." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print a @param" $ @@ -77,13 +77,13 @@ [ "/**" , " * @param p1 hello world." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @param p1 hello world." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print a @param with [in] attribute" $ @@ -91,13 +91,13 @@ [ "/**" , " * @param[in] p1 hello world." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @param[in] p1 hello world." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print a @return" $ @@ -105,13 +105,13 @@ [ "/**" , " * @return hello world." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @return hello world." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print a @retval" $ @@ -120,14 +120,14 @@ , " * @retval 0 Success." , " * @retval 1 Failure." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @retval 0 Success." , " * @retval 1 Failure." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print a bullet list" $ @@ -136,14 +136,14 @@ , " * - item 1" , " * - item 2" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * - item 1" , " * - item 2" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print a nested bullet list" $ @@ -153,7 +153,7 @@ , " * - nested item 1" , " * - item 2" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" @@ -161,7 +161,7 @@ , " * - nested item 1" , " * - item 2" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print a numbered list" $ @@ -170,14 +170,14 @@ , " * 1. item 1" , " * 2. item 2" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * 1. item 1" , " * 2. item 2" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print a code block" $ @@ -188,7 +188,7 @@ , " * y = 3;" , " * @endcode" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" @@ -197,7 +197,7 @@ , " * y = 3;" , " * @endcode" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @deprecated" $ @@ -205,13 +205,13 @@ [ "/**" , " * @deprecated Use new_function instead." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @deprecated Use new_function instead." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @see" $ @@ -219,13 +219,13 @@ [ "/**" , " * @see other_function for more details." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @see other_function for more details." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @attention" $ @@ -233,13 +233,13 @@ [ "/**" , " * @attention This is important." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @attention This is important." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @note" $ @@ -247,13 +247,13 @@ [ "/**" , " * @note This is a note." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @note This is a note." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @private" $ @@ -261,13 +261,13 @@ [ "/**" , " * @private" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @private" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @extends" $ @@ -275,13 +275,13 @@ [ "/**" , " * @extends BaseClass" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @extends BaseClass" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @implements" $ @@ -289,13 +289,13 @@ [ "/**" , " * @implements Interface" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @implements Interface" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @security_rank" $ @@ -303,13 +303,13 @@ [ "/**" , " * @security_rank(sink, data, 1)" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @security_rank(sink, data, 1)" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print a complex comment" $ @@ -324,7 +324,7 @@ , " * @param p1 Description for p1." , " * @return Description for return." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" @@ -337,7 +337,7 @@ , " * @param p1 Description for p1." , " * @return Description for return." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print words with operators" $ @@ -345,13 +345,13 @@ [ "/**" , " * check if x == 5" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * check if x == 5" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @ref" $ @@ -359,13 +359,13 @@ [ "/**" , " * see @ref my_ref" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * see @ref my_ref" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @p" $ @@ -373,13 +373,13 @@ [ "/**" , " * @p my_p" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @p my_p" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @file" $ @@ -387,13 +387,13 @@ [ "/**" , " * @file" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @file" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @section" $ @@ -401,13 +401,13 @@ [ "/**" , " * @section sec_id sec_title" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @section sec_id sec_title" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print @subsection" $ @@ -415,13 +415,13 @@ [ "/**" , " * @subsection subsec_id subsec_title" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * @subsection subsec_id subsec_title" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print words with colon" $ @@ -429,13 +429,13 @@ [ "/**" , " * Note:" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * Note:" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print words with parens" $ @@ -443,13 +443,13 @@ [ "/**" , " * (Note)" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * (Note)" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print words with parens including long sentences going to the next line" $ @@ -458,14 +458,14 @@ , " * This is a comment (and there is more" , " * to say about this)." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * This is a comment (and there is more" , " * to say about this)." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print words with operators" $ @@ -473,13 +473,13 @@ [ "/**" , " * a + b = c" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * a + b = c" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print words with assignment" $ @@ -487,13 +487,13 @@ [ "/**" , " * x = 5" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * x = 5" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should pretty-print sentences with various punctuation" $ @@ -503,7 +503,7 @@ , " * This is exciting!" , " * This is a clause;" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" @@ -511,7 +511,7 @@ , " * This is exciting!" , " * This is a clause;" , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should allow numbers in the text" $ @@ -519,13 +519,13 @@ [ "/**" , " * I have 3 things on my mind." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/**" , " * I have 3 things on my mind." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] it "should allow numbers at the start of the text" $ @@ -534,14 +534,14 @@ , " * I have 3 things on my mind. You have" , " * 20 things on your mind. We are not the same." , " */" - , "const int my_mind = 3;" + , "int const my_mind = 3;" ]) `shouldBe` unlines [ "/**" , " * I have 3 things on my mind. You have" , " * 20 things on your mind. We are not the same." , " */" - , "const int my_mind = 3;" + , "int const my_mind = 3;" ] it "should allow numbers at the end of the sentence at the start of a line" $ @@ -550,14 +550,14 @@ , " * I have 3 things on my mind. The number of things on your mind is" , " * 20." , " */" - , "const int my_mind = 3;" + , "int const my_mind = 3;" ]) `shouldBe` unlines [ "/**" , " * I have 3 things on my mind. The number of things on your mind is" , " * 20." , " */" - , "const int my_mind = 3;" + , "int const my_mind = 3;" ] it "should treat numbers like words and be able to continue normally" $ @@ -567,7 +567,7 @@ , " * 1, maybe more or less, and we can talk a lot about" , " * 2022. This is the next sentence." , " */" - , "const int my_mind = 3;" + , "int const my_mind = 3;" ]) `shouldBe` unlines [ "/**" @@ -575,7 +575,7 @@ , " * 1, maybe more or less, and we can talk a lot about" , " * 2022. This is the next sentence." , " */" - , "const int my_mind = 3;" + , "int const my_mind = 3;" ] it "should print numbered lists as is" $ @@ -588,7 +588,7 @@ , " *" , " * Here is some more text not part of the list items." , " */" - , "const int my_mind = 3;" + , "int const my_mind = 3;" ]) `shouldBe` unlines [ "/**" @@ -599,7 +599,7 @@ , " *" , " * Here is some more text not part of the list items." , " */" - , "const int my_mind = 3;" + , "int const my_mind = 3;" ] it "should pretty-print a doc comment with content on the first line" $ @@ -607,11 +607,11 @@ [ "/** @file test.c" , " * @brief hello world." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ]) `shouldBe` unlines [ "/** @file test.c" , " * @brief hello world." , " */" - , "const int abc = 3;" + , "int const abc = 3;" ] diff --git a/test/Language/Cimple/PrettySpec.hs b/test/Language/Cimple/PrettySpec.hs --- a/test/Language/Cimple/PrettySpec.hs +++ b/test/Language/Cimple/PrettySpec.hs @@ -64,7 +64,7 @@ , " * This is cool stuff." , " */" , "" - , "const int abc = 3;" + , "int const abc = 3;" ] describe "showNode" $ do