diff --git a/src/Tokstyle/C/Linter/VoidCall.hs b/src/Tokstyle/C/Linter/VoidCall.hs index 6534867..efea9fa 100644 --- a/src/Tokstyle/C/Linter/VoidCall.hs +++ b/src/Tokstyle/C/Linter/VoidCall.hs @@ -48,6 +48,7 @@ linter :: AstActions (TravT Env Identity) linter = astActions { doIdentDecl = \node act -> case node of FunctionDef (FunDef (VarDecl (VarName fname _) _ (FunctionType (FunType _ ps _) _)) (CCompound _ body _) _) + | "os_" `isPrefixOf` idName fname -> return () | "sys_" `isPrefixOf` idName fname -> return () | otherwise -> checkFunction (voidPtrParams ps) body diff --git a/src/Tokstyle/C/Patterns.hs b/src/Tokstyle/C/Patterns.hs index c366ecf..d0d0500 100644 --- a/src/Tokstyle/C/Patterns.hs +++ b/src/Tokstyle/C/Patterns.hs @@ -5,6 +5,14 @@ {- HLINT ignore "Use camelCase" -} module Tokstyle.C.Patterns where +import Language.C (CConstant (CIntConst), + CDeclaration (CDecl), + CDeclarationSpecifier (CTypeSpec), + CDeclarator (CDeclr), + CDerivedDeclarator (CPtrDeclr), + CExpression (CCast, CConst), + CInteger (CInteger), + CTypeSpecifier (CVoidType)) import Language.C.Analysis.SemRep (CompTypeRef (..), IntType (..), Type (..), TypeDefRef (..), TypeName (..)) @@ -25,6 +33,8 @@ pattern TY_sockaddr_in_ptr <- TY_struct_ptr "sockaddr_in" pattern TY_sockaddr_in6_ptr <- TY_struct_ptr "sockaddr_in6" pattern TY_canon_bool <- (canonicalType -> DirectType (TyIntegral TyBool) _ _) +pattern E_0 <- CConst (CIntConst (CInteger 0 _ _) _) +pattern E_nullptr <- CCast (CDecl [CTypeSpec (CVoidType _)] [(Just (CDeclr _ [CPtrDeclr [] _] _ _ _),_,_)] _) E_0 _ isEnum :: Type -> Bool isEnum (canonicalType -> DirectType TyEnum{} _ _) = True diff --git a/src/Tokstyle/Linter/DeclsHaveDefns.hs b/src/Tokstyle/Linter/DeclsHaveDefns.hs index cbe4854..1402ff4 100644 --- a/src/Tokstyle/Linter/DeclsHaveDefns.hs +++ b/src/Tokstyle/Linter/DeclsHaveDefns.hs @@ -19,7 +19,6 @@ import Language.Cimple (AlexPosn (..), Lexeme (..), import qualified Language.Cimple.Diagnostics as Diagnostics import Language.Cimple.TraverseAst (AstActions, astActions, doNode, traverseAst) -import System.FilePath (takeFileName) import Text.EditDistance (defaultEditCosts, levenshteinDistance) @@ -77,7 +76,6 @@ analyse = . Map.elems . flip State.execState empty . traverseAst collectPairs - . filter (not . (`elem` ["tox.h", "tox_private.h"]) . takeFileName . fst) where lacksDefn DeclDefn{decl, defn = Nothing} = decl lacksDefn _ = Nothing