Skip to content

Commit a8edbfe

Browse files
committed
feat: Add -Wmemcpy, checking compatibility of dst and src.
Also works on `memcmp`.
1 parent 0cec33f commit a8edbfe

File tree

4 files changed

+91
-0
lines changed

4 files changed

+91
-0
lines changed

src/Tokstyle/C/Linter.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ import qualified Tokstyle.C.Linter.BoolConversion as BoolConversion
1818
import qualified Tokstyle.C.Linter.CallbackParams as CallbackParams
1919
import qualified Tokstyle.C.Linter.Cast as Cast
2020
import qualified Tokstyle.C.Linter.Conversion as Conversion
21+
import qualified Tokstyle.C.Linter.Memcpy as Memcpy
2122
import qualified Tokstyle.C.Linter.Memset as Memset
2223
import qualified Tokstyle.C.Linter.SizeArg as SizeArg
2324
import qualified Tokstyle.C.Linter.Sizeof as Sizeof
@@ -30,6 +31,7 @@ linters =
3031
, ("callback-params" , CallbackParams.analyse )
3132
, ("cast" , Cast.analyse )
3233
, ("conversion" , Conversion.analyse )
34+
, ("memcpy" , Memcpy.analyse )
3335
, ("memset" , Memset.analyse )
3436
, ("size-arg" , SizeArg.analyse )
3537
, ("sizeof" , Sizeof.analyse )

src/Tokstyle/C/Linter/Memcpy.hs

Lines changed: 87 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,87 @@
1+
{-# OPTIONS_GHC -Wwarn #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE Strict #-}
4+
module Tokstyle.C.Linter.Memcpy (analyse) where
5+
6+
import Control.Monad (unless)
7+
import Data.Functor.Identity (Identity)
8+
import Language.C.Analysis.AstAnalysis (ExprSide (..), tExpr)
9+
import Language.C.Analysis.SemError (typeMismatch)
10+
import Language.C.Analysis.SemRep (CompTypeRef (CompTypeRef),
11+
GlobalDecls,
12+
IntType (TyUChar), Type (..),
13+
TypeName (TyComp, TyIntegral, TyVoid))
14+
import Language.C.Analysis.TravMonad (Trav, TravT, recordError)
15+
import Language.C.Analysis.TypeUtils (canonicalType)
16+
import Language.C.Data.Ident (Ident (..))
17+
import Language.C.Pretty (pretty)
18+
import Language.C.Syntax.AST (CExpr, CExpression (..),
19+
annotation)
20+
import Tokstyle.C.Env (Env)
21+
import Tokstyle.C.TraverseAst (AstActions (..), astActions,
22+
traverseAst)
23+
24+
compatibleType :: Type -> Type -> Bool
25+
compatibleType (PtrType a _ _ ) (PtrType b _ _ ) = compatibleType a b
26+
compatibleType (ArrayType a _ _ _) (PtrType b _ _ ) = compatibleType a b
27+
compatibleType (PtrType a _ _ ) (ArrayType b _ _ _) = compatibleType a b
28+
compatibleType (ArrayType a _ _ _) (ArrayType b _ _ _) = compatibleType a b
29+
compatibleType (DirectType a _ _ ) (DirectType b _ _ ) = compatibleTypeName a b
30+
compatibleType _ _ = False
31+
32+
compatibleTypeName :: TypeName -> TypeName -> Bool
33+
-- `uint8_t*` can can be memcpy'd to and from any integral type.
34+
compatibleTypeName (TyIntegral TyUChar) TyIntegral{} = True
35+
compatibleTypeName TyIntegral{} (TyIntegral TyUChar) = True
36+
-- Integral types can only be memcpy'd to the same integral type.
37+
compatibleTypeName (TyIntegral a) (TyIntegral b) = a == b
38+
-- Structs can only be memcpy'd to the exact same struct.
39+
compatibleTypeName (TyComp (CompTypeRef a _ _)) (TyComp (CompTypeRef b _ _)) = a == b
40+
-- Everything else is disallowed.
41+
compatibleTypeName _ TyComp{} = False
42+
compatibleTypeName TyComp{} _ = False
43+
-- Void pointers are disallowed.
44+
compatibleTypeName TyVoid _ = False
45+
compatibleTypeName _ TyVoid = False
46+
-- Error here for now, to discover more cases.
47+
compatibleTypeName a b = error (show a ++ "\n" ++ show b)
48+
49+
validMemType :: Type -> Bool
50+
validMemType (PtrType DirectType{} _ _ ) = True
51+
validMemType (ArrayType DirectType{} _ _ _) = True
52+
validMemType _ = False
53+
54+
checkMemType :: String -> CExpr -> Type -> Trav Env ()
55+
checkMemType fname expr ty =
56+
unless (validMemType (canonicalType ty)) $
57+
let annot = (annotation expr, ty) in
58+
recordError $ typeMismatch
59+
("`" <> fname <> "` argument type `" <> show (pretty ty)
60+
<> "` is not a valid memory type (pointers to arrays are not allowed)")
61+
annot annot
62+
63+
checkCompatibility :: String -> CExpr -> CExpr -> Trav Env ()
64+
checkCompatibility fname dst src = do
65+
dstTy <- tExpr [] RValue dst
66+
srcTy <- tExpr [] RValue src
67+
checkMemType fname dst dstTy
68+
checkMemType fname src srcTy
69+
unless (compatibleType (canonicalType dstTy) (canonicalType srcTy)) $
70+
recordError $ typeMismatch
71+
("`" <> fname <> "` first argument type `" <> show (pretty dstTy)
72+
<> "` is not compatible with second argument type `"
73+
<> show (pretty srcTy) <> "`")
74+
(annotation dst, dstTy) (annotation src, srcTy)
75+
76+
linter :: AstActions (TravT Env Identity)
77+
linter = astActions
78+
{ doExpr = \node act -> case node of
79+
CCall (CVar (Ident fname _ _) _) [dst, src, _] _ | fname `elem` ["memcpy", "memcmp"] -> do
80+
checkCompatibility fname dst src
81+
act
82+
83+
_ -> act
84+
}
85+
86+
analyse :: GlobalDecls -> Trav Env ()
87+
analyse = traverseAst linter

src/Tokstyle/Linter/FuncScopes.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,7 @@ linter = astActions
5555

5656
scopeKeyword Global = "extern"
5757
scopeKeyword Static = "static"
58+
scopeKeyword Local = "local"
5859

5960
analyse :: (FilePath, [Node (Lexeme Text)]) -> [Text]
6061
analyse = reverse . diags . flip State.execState empty . traverseAst linter

tokstyle.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ library
2424
Tokstyle.C.Linter.CallbackParams
2525
Tokstyle.C.Linter.Cast
2626
Tokstyle.C.Linter.Conversion
27+
Tokstyle.C.Linter.Memcpy
2728
Tokstyle.C.Linter.Memset
2829
Tokstyle.C.Linter.SizeArg
2930
Tokstyle.C.Linter.Sizeof

0 commit comments

Comments
 (0)