feat: Add -Wwraparound to check for index out of bounds.

doc/c.md

@@ -1,6 +1,6 @@
 # C-based linters (`check-c`)
 
-There are currently 14 linters implemented.
+There are currently 15 linters implemented.
 
 ## `-Wbool-conversion`
 
@@ -78,3 +78,19 @@ role-based types.
 ## `-Wvoid-call`
 
 Checks that the first statement of a function with a `void*` parameter casts it to a specific type.
+
+## `-Wwraparound`
+
+Checks for integer arithmetic that wraps around where it is used as an index:
+compared to an index reduced with `%` or `&`, reduced with `%` by a size that
+doesn't divide the type's range, or used to index an array it can be past the
+end of. Also checks for the difference of two 16-bit values that wraps around
+at 32 bits because integer promotion computes it in `int`.
+
+The checks follow values through locals and fields, take the conditions that
+guard them into account, and know which values the program stores in struct
+fields, returns from functions, and passes to static functions.
+
+**Reason:** in a ring buffer of size `N`, `(uint16_t)(start - 1)` wraps to
+65535 when `start` is 0, not to `N - 1`. Comparing it to `id % N` then never
+matches. Use `(start + N - 1) % N` instead.

include/.gitignore

@@ -0,0 +1,2 @@
+/sodium
+/sodium.h

src/Tokstyle/C/Analysis/CFG.hs

@@ -8,12 +8,15 @@ module Tokstyle.C.Analysis.CFG
     , fromFunDef
     ) where
 
+import           Control.Monad              (unless)
 import           Control.Monad.Reader
 import           Control.Monad.State
 import           Data.Map.Strict            (Map)
 import qualified Data.Map.Strict            as Map
 import           Language.C.Analysis.SemRep (FunDef (..))
 import           Language.C.Data.Ident      (Ident)
+import           Language.C.Data.Name       (Name)
+import           Language.C.Data.Node       (NodeInfo, nameOfNode)
 import           Language.C.Syntax.AST
 
 -- | A node in the Control Flow Graph.
@@ -59,6 +62,7 @@ data BuildEnv = BuildEnv
     , envContinue :: Maybe Node
     , envReturn   :: Node
     , envLabels   :: Map Ident Node
+    , envCases    :: Map Name Node
     }
 
 data BuildState = BuildState
@@ -83,7 +87,7 @@ fromFunDef (FunDef _ (CCompound _ items _) _) =
     let (exitNode, s0) = runState (newNodeState ExitNode) (BuildState 0 Map.empty)
         (entryNode, s1) = runState (newNodeState EntryNode) s0
         (labels, s2) = runState (execStateT (mapM_ collectBlockItem items) Map.empty) s1
-        env = BuildEnv Nothing Nothing exitNode labels
+        env = BuildEnv Nothing Nothing exitNode labels Map.empty
         (actualEntry, s3) = runState (runReaderT (buildBlock items exitNode) env) s2
         (_, s4) = runState (addEdgeM entryNode Unconditional actualEntry) s3
     in (entryNode, stateEdges s4)
@@ -99,6 +103,9 @@ fromFunDef (FunDef _ (CCompound _ items _) _) =
         CCompound _ bis _  -> mapM_ collectBlockItem bis
         CIf _ t e _        -> collectStat t >> maybe (return ()) collectStat e
         CSwitch _ s _      -> collectStat s
+        CCase _ s _        -> collectStat s
+        CCases _ _ s _     -> collectStat s
+        CDefault s _       -> collectStat s
         CWhile _ s _ _     -> collectStat s
         CFor _ _ _ s _     -> collectStat s
         _                  -> return ()
@@ -150,14 +157,29 @@ buildStat stat next = case stat of
         lift $ addEdgeM node FalseBranch eEntry
         return node
 
-    CWhile cond s _ _ -> do
+    CWhile cond s isDo _ -> do
         node <- newNode (BranchNode cond)
         sEntry <- local (\env -> env { envBreak = Just next, envContinue = Just node }) $
             buildStat s node
         lift $ addEdgeM node TrueBranch sEntry
         lift $ addEdgeM node FalseBranch next
+        return $ if isDo then sEntry else node
+
+    CSwitch cond s _ -> do
+        node <- newNode (BranchNode cond)
+        labels <- caseLabels s
+        let cases = Map.fromList [ (n, c) | (Just n, _, c, _) <- labels ]
+        _ <- local (\env -> env { envBreak = Just next, envCases = cases }) $
+            buildStat s next
+        mapM_ (\(_, edge, c, _) -> lift $ addEdgeM node edge c) labels
+        unless (or [ isDefault | (_, _, _, isDefault) <- labels ]) $
+            lift $ addEdgeM node DefaultBranch next
         return node
 
+    CCase _ s ni -> caseStat s ni next
+    CCases _ _ s ni -> caseStat s ni next
+    CDefault s ni -> caseStat s ni next
+
     CFor init' mCond mStep s _ -> do
         condNode <- case mCond of
                          Just cond -> newNode (BranchNode cond)
@@ -221,3 +243,31 @@ buildStat stat next = case stat of
         node <- newNode (StatNode stat)
         lift $ addEdgeM node Unconditional next
         return node
+
+-- | The labels of a switch body, not counting those of nested switches, with
+-- the edges that lead to them and whether they are the @default@ label.
+caseLabels :: CStat -> BuildM [(Maybe Name, EdgeType, Node, Bool)]
+caseLabels = \case
+    CCase e s ni     -> label ni (CaseBranch e) False s
+    CCases _ _ s ni  -> label ni DefaultBranch False s
+    CDefault s ni    -> label ni DefaultBranch True s
+    CLabel _ s _ _   -> caseLabels s
+    CCompound _ bis _ -> concat <$> mapM caseLabels [ s | CBlockStmt s <- bis ]
+    CIf _ t e _      -> (++) <$> caseLabels t <*> maybe (return []) caseLabels e
+    CWhile _ s _ _   -> caseLabels s
+    CFor _ _ _ s _   -> caseLabels s
+    _                -> return []
+  where
+    label ni edge isDefault s = do
+        node <- newNode (StatNode (CExpr Nothing ni))
+        ((nameOfNode ni, edge, node, isDefault) :) <$> caseLabels s
+
+-- | A case label: the node the switch jumps to, followed by its statement.
+caseStat :: CStat -> NodeInfo -> Node -> BuildM Node
+caseStat s ni next = do
+    sEntry <- buildStat s next
+    asks (\env -> nameOfNode ni >>= (`Map.lookup` envCases env)) >>= \case
+        Just node -> do
+            lift $ addEdgeM node Unconditional sEntry
+            return node
+        Nothing -> return sEntry