From 070a465b64f0760023e081563d6f783fb608b155 Mon Sep 17 00:00:00 2001
From: Vidar Holen <spam@vidarholen.net>
Date: Sun, 28 May 2017 13:38:04 -0700
Subject: [PATCH] Recognize missing and superfluous cases in getopts loops.

---
 ShellCheck/AnalyzerLib.hs     | 21 +++++++++--
 ShellCheck/Checks/Commands.hs | 71 ++++++++++++++++++++++++++++++++++-
 2 files changed, 87 insertions(+), 5 deletions(-)

diff --git a/ShellCheck/AnalyzerLib.hs b/ShellCheck/AnalyzerLib.hs
index a58111c..605b015 100644
--- a/ShellCheck/AnalyzerLib.hs
+++ b/ShellCheck/AnalyzerLib.hs
@@ -268,10 +268,13 @@ isParamTo tree cmd =
 -- Get the parent command (T_Redirecting) of a Token, if any.
 getClosestCommand :: Map.Map Id Token -> Token -> Maybe Token
 getClosestCommand tree t =
-    msum . map getCommand $ getPath tree t
+    findFirst findCommand $ getPath tree t
   where
-    getCommand t@T_Redirecting {} = return t
-    getCommand _ = Nothing
+    findCommand t =
+        case t of
+            T_Redirecting {} -> return True
+            T_Script {} -> return False
+            _ -> Nothing
 
 -- Like above, if koala_man knew Haskell when starting this project.
 getClosestCommandM t = do
@@ -310,6 +313,18 @@ pathTo t = do
     parents <- reader parentMap
     return $ getPath parents t
 
+-- Find the first match in a list where the predicate is Just True.
+-- Stops if it's Just False and ignores Nothing.
+findFirst :: (a -> Maybe Bool) -> [a] -> Maybe a
+findFirst p l =
+    case l of
+        [] -> Nothing
+        (x:xs) ->
+            case p x of
+                Just True -> return x
+                Just False -> Nothing
+                Nothing -> findFirst p xs
+
 -- Check whether a word is entirely output from a single command
 tokenIsJustCommandOutput t = case t of
     T_NormalWord id [T_DollarExpansion _ cmds] -> check cmds
diff --git a/ShellCheck/Checks/Commands.hs b/ShellCheck/Checks/Commands.hs
index 38cc2a2..4a17f69 100644
--- a/ShellCheck/Checks/Commands.hs
+++ b/ShellCheck/Checks/Commands.hs
@@ -38,7 +38,7 @@ import Control.Monad.RWS
 import Data.Char
 import Data.List
 import Data.Maybe
-import qualified Data.Map as Map
+import qualified Data.Map.Strict as Map
 import Test.QuickCheck.All (forAllProperties)
 import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess)
 
@@ -85,13 +85,14 @@ commandChecks = [
     ,checkDeprecatedTempfile
     ,checkDeprecatedEgrep
     ,checkDeprecatedFgrep
+    ,checkWhileGetoptsCase
     ]
 
 buildCommandMap :: [CommandCheck] -> Map.Map CommandName (Token -> Analysis)
 buildCommandMap = foldl' addCheck Map.empty
   where
     addCheck map (CommandCheck name function) =
-        Map.insertWith' composeAnalyzers name function map
+        Map.insertWith composeAnalyzers name function map
 
 
 checkCommand :: Map.Map CommandName (Token -> Analysis) -> Token -> Analysis
@@ -690,5 +691,71 @@ prop_checkDeprecatedFgrep = verify checkDeprecatedFgrep "fgrep '*' files"
 checkDeprecatedFgrep = CommandCheck (Basename "fgrep") $
     \t -> info (getId t) 2197 "fgrep is non-standard and deprecated. Use grep -F instead."
 
+prop_checkWhileGetoptsCase1 = verify checkWhileGetoptsCase "while getopts 'a:b' x; do case $x in a) foo;; esac; done"
+prop_checkWhileGetoptsCase2 = verify checkWhileGetoptsCase "while getopts 'a:' x; do case $x in a) foo;; b) bar;; esac; done"
+prop_checkWhileGetoptsCase3 = verifyNot checkWhileGetoptsCase "while getopts 'a:b' x; do case $x in a) foo;; b) bar;; esac; done"
+prop_checkWhileGetoptsCase4 = verifyNot checkWhileGetoptsCase "while getopts 'a:123' x; do case $x in a) foo;; [0-9]) bar;; esac; done"
+prop_checkWhileGetoptsCase5 = verifyNot checkWhileGetoptsCase "while getopts 'a:' x; do case $x in a) foo;; \\?) bar;; *) baz;; esac; done"
+checkWhileGetoptsCase = CommandCheck (Exactly "getopts") f
+  where
+    f :: Token -> Analysis
+    f t@(T_SimpleCommand _ _ (cmd:arg1:_))  = do
+        path <- getPathM t
+        potentially $ do
+            options <- getLiteralString arg1
+            (T_WhileExpression _ _ body) <- findFirst whileLoop path
+            caseCmd <- mapMaybe findCase body !!! 0
+            return $ check (getId arg1) (map (:[]) $ filter (/= ':') options) caseCmd
+    f _ = return ()
+
+    check :: Id -> [String] -> Token -> Analysis
+    check optId opts (T_CaseExpression id _ list) = do
+            unless (Nothing `Map.member` handledMap) $
+                mapM_ (warnUnhandled optId id) $ catMaybes $ Map.keys notHandled
+
+            mapM_ warnRedundant $ Map.toList notRequested
+
+        where
+            handledMap = Map.fromList (concatMap getHandledStrings list)
+            requestedMap = Map.fromList $ map (\x -> (Just x, ())) opts
+
+            notHandled = Map.difference requestedMap handledMap
+            notRequested = Map.difference handledMap requestedMap
+
+    warnUnhandled optId caseId str =
+        warn caseId 2213 $ "getopts specified -" ++ str ++ ", but it's not handled by this 'case'."
+
+    warnRedundant (key, expr) = potentially $ do
+        str <- key
+        guard $ str `notElem` ["*", ":", "?"]
+        return $ warn (getId expr) 2214 "This case is not specified by getopts."
+
+    getHandledStrings (_, globs, _) =
+        map (\x -> (literal x, x)) globs
+
+    literal :: Token -> Maybe String
+    literal t = do
+        getLiteralString t <> fromGlob t
+
+    fromGlob t =
+        case t of
+            T_Glob _ ('[':c:']':[]) -> return [c]
+            T_Glob _ "*" -> return "*"
+            _ -> Nothing
+
+    whileLoop t =
+        case t of
+            T_WhileExpression {} -> return True
+            T_Script {} -> return False
+            _ -> Nothing
+
+    findCase t =
+        case t of
+            T_Annotation _ _ x -> findCase x
+            T_Pipeline _ _ [x] -> findCase x
+            T_Redirecting _ _ x@(T_CaseExpression {}) -> return x
+            _ -> Nothing
+
+
 return []
 runTests =  $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])