From 0b616156c901d7c7372b880a59dd7cf0c77e167a Mon Sep 17 00:00:00 2001 From: iphydf Date: Mon, 12 Feb 2024 10:18:06 +0000 Subject: [PATCH] feat: Add `-Wmemcpy`, checking compatibility of `dst` and `src`. Also works on `memcmp`. --- src/Tokstyle/C/Linter.hs | 2 + src/Tokstyle/C/Linter/Memcpy.hs | 87 +++++++++++++++++++++++++++++++++ tokstyle.cabal | 1 + 3 files changed, 90 insertions(+) create mode 100644 src/Tokstyle/C/Linter/Memcpy.hs diff --git a/src/Tokstyle/C/Linter.hs b/src/Tokstyle/C/Linter.hs index 0b40af5..8b337a4 100644 --- a/src/Tokstyle/C/Linter.hs +++ b/src/Tokstyle/C/Linter.hs @@ -18,6 +18,7 @@ import qualified Tokstyle.C.Linter.BoolConversion as BoolConversion import qualified Tokstyle.C.Linter.CallbackParams as CallbackParams import qualified Tokstyle.C.Linter.Cast as Cast import qualified Tokstyle.C.Linter.Conversion as Conversion +import qualified Tokstyle.C.Linter.Memcpy as Memcpy import qualified Tokstyle.C.Linter.Memset as Memset import qualified Tokstyle.C.Linter.SizeArg as SizeArg import qualified Tokstyle.C.Linter.Sizeof as Sizeof @@ -30,6 +31,7 @@ linters = , ("callback-params" , CallbackParams.analyse ) , ("cast" , Cast.analyse ) , ("conversion" , Conversion.analyse ) + , ("memcpy" , Memcpy.analyse ) , ("memset" , Memset.analyse ) , ("size-arg" , SizeArg.analyse ) , ("sizeof" , Sizeof.analyse ) diff --git a/src/Tokstyle/C/Linter/Memcpy.hs b/src/Tokstyle/C/Linter/Memcpy.hs new file mode 100644 index 0000000..da4373d --- /dev/null +++ b/src/Tokstyle/C/Linter/Memcpy.hs @@ -0,0 +1,87 @@ +{-# OPTIONS_GHC -Wwarn #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Strict #-} +module Tokstyle.C.Linter.Memcpy (analyse) where + +import Control.Monad (unless) +import Data.Functor.Identity (Identity) +import Language.C.Analysis.AstAnalysis (ExprSide (..), tExpr) +import Language.C.Analysis.SemError (typeMismatch) +import Language.C.Analysis.SemRep (CompTypeRef (CompTypeRef), + GlobalDecls, + IntType (TyUChar), Type (..), + TypeName (TyComp, TyIntegral, TyVoid)) +import Language.C.Analysis.TravMonad (Trav, TravT, recordError) +import Language.C.Analysis.TypeUtils (canonicalType) +import Language.C.Data.Ident (Ident (..)) +import Language.C.Pretty (pretty) +import Language.C.Syntax.AST (CExpr, CExpression (..), + annotation) +import Tokstyle.C.Env (Env) +import Tokstyle.C.TraverseAst (AstActions (..), astActions, + traverseAst) + +compatibleType :: Type -> Type -> Bool +compatibleType (PtrType a _ _ ) (PtrType b _ _ ) = compatibleType a b +compatibleType (ArrayType a _ _ _) (PtrType b _ _ ) = compatibleType a b +compatibleType (PtrType a _ _ ) (ArrayType b _ _ _) = compatibleType a b +compatibleType (ArrayType a _ _ _) (ArrayType b _ _ _) = compatibleType a b +compatibleType (DirectType a _ _ ) (DirectType b _ _ ) = compatibleTypeName a b +compatibleType _ _ = False + +compatibleTypeName :: TypeName -> TypeName -> Bool +-- `uint8_t*` can can be memcpy'd to and from any integral type. +compatibleTypeName (TyIntegral TyUChar) TyIntegral{} = True +compatibleTypeName TyIntegral{} (TyIntegral TyUChar) = True +-- Integral types can only be memcpy'd to the same integral type. +compatibleTypeName (TyIntegral a) (TyIntegral b) = a == b +-- Structs can only be memcpy'd to the exact same struct. +compatibleTypeName (TyComp (CompTypeRef a _ _)) (TyComp (CompTypeRef b _ _)) = a == b +-- Everything else is disallowed. +compatibleTypeName _ TyComp{} = False +compatibleTypeName TyComp{} _ = False +-- Void pointers are disallowed. +compatibleTypeName TyVoid _ = False +compatibleTypeName _ TyVoid = False +-- Error here for now, to discover more cases. +compatibleTypeName a b = error (show a ++ "\n" ++ show b) + +validMemType :: Type -> Bool +validMemType (PtrType DirectType{} _ _ ) = True +validMemType (ArrayType DirectType{} _ _ _) = True +validMemType _ = False + +checkMemType :: String -> CExpr -> Type -> Trav Env () +checkMemType fname expr ty = + unless (validMemType (canonicalType ty)) $ + let annot = (annotation expr, ty) in + recordError $ typeMismatch + ("`" <> fname <> "` argument type `" <> show (pretty ty) + <> "` is not a valid memory type (pointers to arrays are not allowed)") + annot annot + +checkCompatibility :: String -> CExpr -> CExpr -> Trav Env () +checkCompatibility fname dst src = do + dstTy <- tExpr [] RValue dst + srcTy <- tExpr [] RValue src + checkMemType fname dst dstTy + checkMemType fname src srcTy + unless (compatibleType (canonicalType dstTy) (canonicalType srcTy)) $ + recordError $ typeMismatch + ("`" <> fname <> "` first argument type `" <> show (pretty dstTy) + <> "` is not compatible with second argument type `" + <> show (pretty srcTy) <> "`") + (annotation dst, dstTy) (annotation src, srcTy) + +linter :: AstActions (TravT Env Identity) +linter = astActions + { doExpr = \node act -> case node of + CCall (CVar (Ident fname _ _) _) [dst, src, _] _ | fname `elem` ["memcpy", "memcmp"] -> do + checkCompatibility fname dst src + act + + _ -> act + } + +analyse :: GlobalDecls -> Trav Env () +analyse = traverseAst linter diff --git a/tokstyle.cabal b/tokstyle.cabal index bb55986..9f1e16c 100644 --- a/tokstyle.cabal +++ b/tokstyle.cabal @@ -24,6 +24,7 @@ library Tokstyle.C.Linter.CallbackParams Tokstyle.C.Linter.Cast Tokstyle.C.Linter.Conversion + Tokstyle.C.Linter.Memcpy Tokstyle.C.Linter.Memset Tokstyle.C.Linter.SizeArg Tokstyle.C.Linter.Sizeof