diff --git a/BUILD.bazel b/BUILD.bazel index 7af3efa..55df599 100644 --- a/BUILD.bazel +++ b/BUILD.bazel @@ -38,6 +38,7 @@ haskell_library( "//third_party/haskell:array", "//third_party/haskell:base", "//third_party/haskell:bytestring", + "//third_party/haskell:casing", "//third_party/haskell:containers", "//third_party/haskell:data-fix", "//third_party/haskell:deepseq", diff --git a/src/Tokstyle/Linter.hs b/src/Tokstyle/Linter.hs index 58f7fc7..15dc1e6 100644 --- a/src/Tokstyle/Linter.hs +++ b/src/Tokstyle/Linter.hs @@ -18,6 +18,7 @@ import qualified Tokstyle.Linter.CallocArgs as CallocArgs import qualified Tokstyle.Linter.CallocType as CallocType import qualified Tokstyle.Linter.CompoundInit as CompoundInit import qualified Tokstyle.Linter.Constness as Constness +import qualified Tokstyle.Linter.EnumDefines as EnumDefines import qualified Tokstyle.Linter.EnumNames as EnumNames import qualified Tokstyle.Linter.FuncPrototypes as FuncPrototypes import qualified Tokstyle.Linter.FuncScopes as FuncScopes @@ -64,6 +65,7 @@ localLinters = , ("calloc-type" , CallocType.analyse ) , ("compound-init" , CompoundInit.analyse ) , ("constness" , Constness.analyse ) + , ("enum-defines" , EnumDefines.analyse ) , ("enum-names" , EnumNames.analyse ) , ("func-prototypes" , FuncPrototypes.analyse ) , ("func-scopes" , FuncScopes.analyse ) diff --git a/src/Tokstyle/Linter/EnumDefines.hs b/src/Tokstyle/Linter/EnumDefines.hs new file mode 100644 index 0000000..e1439c3 --- /dev/null +++ b/src/Tokstyle/Linter/EnumDefines.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +module Tokstyle.Linter.EnumDefines (analyse) where + +import Control.Monad (when) +import Control.Monad.State.Strict (State) +import qualified Control.Monad.State.Strict as State +import Data.Fix (Fix (..)) +import qualified Data.List as List +import Data.Text (Text) +import qualified Data.Text as Text +import Language.Cimple (Lexeme (..), LiteralType (..), + Node, NodeF (..)) +import Language.Cimple.Diagnostics (HasDiagnostics (..), warn) +import Language.Cimple.TraverseAst (AstActions, astActions, doNode, + traverseAst) +import Text.Casing (fromHumps, fromSnake, toPascal, + toSnake, unIdentifier) +import Text.Read (readMaybe) + + +minSequence :: Int +minSequence = 5 + +minComponents :: Int +minComponents = 2 + +maxSmallInt :: Int +maxSmallInt = 0xff + +data Linter = Linter + { diags :: [Text] + , defs :: [Text] + } + +instance HasDiagnostics Linter where + addDiagnostic diag l@Linter{diags} = l{diags = addDiagnostic diag diags} + +empty :: Linter +empty = Linter [] [] + +addDef :: Text -> Linter -> Linter +addDef def l@Linter{defs} = l{defs = def:defs} + +clearDefs :: Linter -> Linter +clearDefs l = l{defs = []} + +commonPrefix :: [String] -> String +commonPrefix [] = "" +commonPrefix l = foldl1 go l + where + go _ [] = [] + go [] _ = [] + go (x:xs) (y:ys) + | x == y = x : go xs ys + | otherwise = [] + + +checkEnumDefs :: FilePath -> Node (Lexeme Text) -> State Linter () +checkEnumDefs file node = do + Linter{defs} <- State.get + let cp = commonPrefix $ map Text.unpack defs + when (length defs == minSequence && "_" `List.isSuffixOf` cp && numComponents cp >= minComponents) $ + warn file node $ "sequence of `#define`s longer than " <> Text.pack (show minSequence) + <> " could be written as `enum " <> toEnumName cp <> "`" + + where + numComponents = length . unIdentifier . fromSnake + toEnumName = Text.pack . toSnake . fromHumps . toPascal . fromSnake + + +isSmallInt :: Text -> Bool +isSmallInt txt = + case readMaybe $ Text.unpack txt of + Nothing -> False + Just num -> num <= maxSmallInt + + +linter :: AstActions (State Linter) Text +linter = astActions + { doNode = \file node act -> + case unFix node of + PreprocDefineConst (L _ _ name) (Fix (LiteralExpr Int (L _ _ num))) | isSmallInt num -> do + State.modify $ addDef name + checkEnumDefs file node + + -- Skip comments, don't clear defs. + Comment{} -> act + + _ -> do + act -- Recurse first, check defs later. + checkEnumDefs file node + -- Clear defs whenever we see a new kind of node (not comment or #define). + State.modify clearDefs + } + +analyse :: (FilePath, [Node (Lexeme Text)]) -> [Text] +analyse = reverse . diags . flip State.execState empty . traverseAst linter diff --git a/test/Tokstyle/Linter/EnumDefinesSpec.hs b/test/Tokstyle/Linter/EnumDefinesSpec.hs new file mode 100644 index 0000000..69743b5 --- /dev/null +++ b/test/Tokstyle/Linter/EnumDefinesSpec.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE OverloadedStrings #-} +module Tokstyle.Linter.EnumDefinesSpec where + +import Test.Hspec (Spec, it, shouldBe) + +import Tokstyle.Linter (allWarnings, analyseLocal) +import Tokstyle.LinterSpec (mustParse) + + +spec :: Spec +spec = do + it "suggests using enums for long sequences of #defines" $ do + ast <- mustParse + [ "#define FOO_BAR_ONE 1" + , "#define FOO_BAR_TWO 2" + , "#define FOO_BAR_THREE 3" + , "#define FOO_BAR_FOUR 4" + , "#define FOO_BAR_FIVE 5" + ] + analyseLocal allWarnings ("test.c", ast) + `shouldBe` + [ "test.c:5: sequence of `#define`s longer than 5 could be written as `enum Foo_Bar` [-Wenum-defines]" + ] + + it "allows comments to be interspersed in the enum" $ do + ast <- mustParse + [ "#define FOO_BAR_ONE 1" + , "#define FOO_BAR_TWO 2" + , "// some comment here" + , "#define FOO_BAR_THREE 3" + , "/* another comment here */" + , "#define FOO_BAR_FOUR 4" + , "#define FOO_BAR_FIVE 5" + ] + analyseLocal allWarnings ("test.c", ast) + `shouldBe` + [ "test.c:7: sequence of `#define`s longer than 5 could be written as `enum Foo_Bar` [-Wenum-defines]" + ] + + it "ignores broken sequences" $ do + ast <- mustParse + [ "#define FOO_BAR_ONE 1" + , "#define FOO_BAR_TWO 2" + , "static const uint32_t xxx = 10;" -- breaks the sequence, we ignore this because it doesn't look like an enum + , "#define FOO_BAR_THREE 3" + , "#define FOO_BAR_FOUR 4" + , "#define FOO_BAR_FIVE 5" + ] + analyseLocal allWarnings ("test.c", ast) + `shouldBe` [] + + it "ignores defines with large values" $ do + ast <- mustParse + [ "#define FOO_BAR_ONE 1" + , "#define FOO_BAR_TWO 0x20" + , "#define FOO_BAR_THREE 300" + , "#define FOO_BAR_FOUR 4" + , "#define FOO_BAR_FIVE 5" + ] + analyseLocal allWarnings ("test.c", ast) + `shouldBe` [] diff --git a/tokstyle.cabal b/tokstyle.cabal index 788945f..14265c5 100644 --- a/tokstyle.cabal +++ b/tokstyle.cabal @@ -43,6 +43,7 @@ library Tokstyle.Linter.DeclaredOnce Tokstyle.Linter.DeclsHaveDefns Tokstyle.Linter.DocComments + Tokstyle.Linter.EnumDefines Tokstyle.Linter.EnumNames Tokstyle.Linter.FuncPrototypes Tokstyle.Linter.FuncScopes @@ -74,6 +75,7 @@ library , base >=4 && <5 , bytestring <0.13 , cimple >=0.0.18 + , casing <0.2 , containers <0.8 , data-fix <0.4 , deepseq <2 @@ -147,6 +149,7 @@ test-suite testsuite Tokstyle.Linter.CallocTypeSpec Tokstyle.Linter.CompoundInitSpec Tokstyle.Linter.ConstnessSpec + Tokstyle.Linter.EnumDefinesSpec Tokstyle.Linter.ParensSpec Tokstyle.Linter.SwitchIfSpec Tokstyle.Linter.TypeCheckSpec