Rewrite getopts style option parser

src/ShellCheck/ASTLib.hs

@@ -30,6 +30,8 @@ import Data.List
 import Data.Maybe
 import qualified Data.Map as Map
 
+arguments (T_SimpleCommand _ _ (cmd:args)) = args
+
 -- Is this a type of loop?
 isLoop t = case t of
         T_WhileExpression {} -> True
@@ -135,32 +137,91 @@ isUnquotedFlag token = fromMaybe False $ do
     str <- getLeadingUnquotedString token
     return $ "-" `isPrefixOf` str
 
--- getGnuOpts "erd:u:" will parse a SimpleCommand like
+-- getGnuOpts "erd:u:" will parse a list of arguments tokens like `read`
---     read -re -d : -u 3 bar
+--     -re -d : -u 3 bar
 -- into
---     Just [("r", -re), ("e", -re), ("d", :), ("u", 3), ("", bar)]
+--     Just [("r", (-re, -re)), ("e", (-re, -re)), ("d", (-d,:)), ("u", (-u,3)), ("", (bar,bar))]
--- where flags with arguments map to arguments, while others map to themselves.
+--
--- Any unrecognized flag will result in Nothing.
+-- Each string flag maps to a tuple of (flag, argument), where argument=flag if it
-getGnuOpts str t = getOpts str $ getAllFlags t
+-- doesn't take a specific one.
-getBsdOpts str t = getOpts str $ getLeadingFlags t
+--
-getOpts :: String -> [(Token, String)] -> Maybe [(String, Token)]
+-- Any unrecognized flag will result in Nothing. The exception is if arbitraryLongOpts
-getOpts string flags = process flags
+-- is set, in which case --anything will map to "anything".
+getGnuOpts :: String -> [Token] -> Maybe [(String, (Token, Token))]
+getGnuOpts str args = getOpts (True, False) str [] args
+
+-- As above, except the first non-arg string will treat the rest as arguments
+getBsdOpts :: String -> [Token] -> Maybe [(String, (Token, Token))]
+getBsdOpts str args = getOpts (False, False) str [] args
+
+-- Tests for this are in Commands.hs where it's more frequently used
+getOpts ::
+    -- Behavioral config: gnu style, allow arbitrary long options
+    (Bool, Bool)
+    -- A getopts style string
+    -> String
+    -- List of long options and whether they take arguments
+    -> [(String, Bool)]
+    -- List of arguments (excluding command)
+    -> [Token]
+    -- List of flags to tuple of (optionToken, valueToken)
+    -> Maybe [(String, (Token, Token))]
+
+getOpts (gnu, arbitraryLongOpts) string longopts args = process args
   where
     flagList (c:':':rest) = ([c], True) : flagList rest
     flagList (c:rest)     = ([c], False) : flagList rest
-    flagList []           = []
+    flagList []           = longopts
     flagMap = Map.fromList $ ("", False) : flagList string
 
     process [] = return []
-    process ((token1, flag):rest1) = do
+    process (token:rest) = do
-        takesArg <- Map.lookup flag flagMap
+        case getLiteralStringDef "\0" token of
-        (token, rest) <- if takesArg
+            '-':'-':[] -> return $ listToArgs rest
-            then case rest1 of
+            '-':'-':word -> do
-                (token2, ""):rest2 -> return (token2, rest2)
+                let (name, arg) = span (/= '=') word
-                _ -> fail "takesArg without valid arg"
+                needsArg <-
-            else return (token1, rest1)
+                    if arbitraryLongOpts
+                    then return $ Map.findWithDefault False name flagMap
+                    else Map.lookup name flagMap
+
+                if needsArg && null arg
+                  then
+                    case rest of
+                        (arg:rest2) -> do
+                            more <- process rest2
+                            return $ (name, (token, arg)) : more
+                        _ -> fail "Missing arg"
+                  else do
                     more <- process rest
-        return $ (flag, token) : more
+                    -- Consider splitting up token to get arg
+                    return $ (name, (token, token)) : more
+            '-':opts -> shortToOpts opts token rest
+            arg ->
+                if gnu
+                then do
+                    more <- process rest
+                    return $ ("", (token, token)):more
+                else return $ listToArgs (token:rest)
+
+    shortToOpts opts token args =
+        case opts of
+            c:rest -> do
+                needsArg <- Map.lookup [c] flagMap
+                case () of
+                    _ | needsArg && null rest -> do
+                        (next:restArgs) <- return args
+                        more <- process restArgs
+                        return $ ([c], (token, next)):more
+                    _ | needsArg -> do
+                        more <- process args
+                        return $ ([c], (token, token)):more
+                    _ -> do
+                        more <- shortToOpts rest token args
+                        return $ ([c], (token, token)):more
+            [] -> process args
+
+    listToArgs = map (\x -> ("", (x, x)))
 
 -- Is this an expansion of multiple items of an array?
 isArrayExpansion (T_DollarBraced _ _ l) =
@@ -362,8 +423,8 @@ getCommandNameAndToken direct t = fromMaybe (Nothing, t) $ do
                 "builtin" -> firstArg
                 "command" -> firstArg
                 "exec" -> do
-                    opts <- getBsdOpts "cla:" cmd
+                    opts <- getBsdOpts "cla:" args
-                    (_, t) <- listToMaybe $ filter (null . fst) opts
+                    (_, (t, _)) <- listToMaybe $ filter (null . fst) opts
                     return t
                 _ -> fail ""
 

src/ShellCheck/Analytics.hs

@@ -2925,8 +2925,8 @@ checkReadWithoutR _ t@T_SimpleCommand {} | t `isUnqualifiedCommand` "read"
   where
     flags = getAllFlags t
     has_t0 = Just "0" == do
-        parsed <- getOpts flagsForRead flags
+        parsed <- getGnuOpts flagsForRead $ arguments t
-        t <- lookup "t" parsed
+        (_, t) <- lookup "t" parsed
         getLiteralString t
 
 checkReadWithoutR _ _ = return ()
@@ -3383,7 +3383,7 @@ checkPipeToNowhere params t =
 
     commandSpecificException name cmd =
         case name of
-            "du" -> any (`elem` ["exclude-from", "files0-from"]) $ lt $ map snd $ getAllFlags cmd
+            "du" -> any (`elem` ["exclude-from", "files0-from"]) $ map snd $ getAllFlags cmd
             _ -> False
 
     warnAboutDupes (n, list@(_:_:_)) =

src/ShellCheck/AnalyzerLib.hs

@@ -678,13 +678,13 @@ getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T
       where
         parseArgs :: Maybe (Token, Token, String, DataType)
         parseArgs = do
-            args <- getGnuOpts "d:n:O:s:u:C:c:t" base
+            args <- getGnuOpts "d:n:O:s:u:C:c:t" rest
             let names = map snd $ filter (\(x,y) -> null x) args
             if null names
                 then
                     return (base, base, "MAPFILE", DataArray SourceExternal)
                 else do
-                    first <- listToMaybe names
+                    (_, first) <- listToMaybe names
                     name <- getLiteralString first
                     guard $ isVariableName name
                     return (base, first, name, DataArray SourceExternal)

src/ShellCheck/Checks/Commands.hs

@@ -53,8 +53,6 @@ verify :: CommandCheck -> String -> Bool
 verify f s = producesComments (getChecker [f]) s == Just True
 verifyNot f s = producesComments (getChecker [f]) s == Just False
 
-arguments (T_SimpleCommand _ _ (cmd:args)) = args
-
 commandChecks :: [CommandCheck]
 commandChecks = [
     checkTr
@@ -116,6 +114,35 @@ prop_verifyOptionalExamples = all check optionalCommandChecks
       verify check (cdPositive desc)
       && verifyNot check (cdNegative desc)
 
+-- Run a check against the getopt parser. If it fails, the lists are empty.
+checkGetOpts str flags args f =
+    flags == actualFlags && args == actualArgs
+  where
+    toTokens = map (T_Literal (Id 0)) . words
+    opts = fromMaybe [] $ f (toTokens str)
+    actualFlags = filter (not . null) $ map fst opts
+    actualArgs = map (\(_, (_, x)) -> onlyLiteralString x) $ filter (null . fst) opts
+
+-- Short options
+prop_checkGetOptsS1 = checkGetOpts "-f x" ["f"] [] $ getOpts (True, True) "f:" []
+prop_checkGetOptsS2 = checkGetOpts "-fx" ["f"] [] $ getOpts (True, True) "f:" []
+prop_checkGetOptsS3 = checkGetOpts "-f -x" ["f", "x"] [] $ getOpts (True, True) "fx" []
+prop_checkGetOptsS4 = checkGetOpts "-f -x" ["f"] [] $ getOpts (True, True) "f:" []
+prop_checkGetOptsS5 = checkGetOpts "-fx" [] [] $ getOpts (True, True) "fx:" []
+
+-- Long options
+prop_checkGetOptsL1 = checkGetOpts "--foo=bar baz" ["foo"] ["baz"] $ getOpts (True, False) "" [("foo", True)]
+prop_checkGetOptsL2 = checkGetOpts "--foo bar baz" ["foo"] ["baz"] $ getOpts (True, False) "" [("foo", True)]
+prop_checkGetOptsL3 = checkGetOpts "--foo baz" ["foo"] ["baz"] $ getOpts (True, True) "" []
+prop_checkGetOptsL4 = checkGetOpts "--foo baz" [] [] $ getOpts (True, False) "" []
+
+-- Know when to terminate
+prop_checkGetOptsT1 = checkGetOpts "-a x -b" ["a", "b"] ["x"] $ getOpts (True, True) "ab" []
+prop_checkGetOptsT2 = checkGetOpts "-a x -b" ["a"] ["x","-b"] $ getOpts (False, True) "ab" []
+prop_checkGetOptsT3 = checkGetOpts "-a -- -b" ["a"] ["-b"] $ getOpts (True, True) "ab" []
+prop_checkGetOptsT4 = checkGetOpts "-a -- -b" ["a", "b"] [] $ getOpts (True, True) "a:b" []
+
+
 buildCommandMap :: [CommandCheck] -> Map.Map CommandName (Token -> Analysis)
 buildCommandMap = foldl' addCheck Map.empty
   where
@@ -694,8 +721,8 @@ checkReadExpansions = CommandCheck (Exactly "read") check
   where
     options = getGnuOpts flagsForRead
     getVars cmd = fromMaybe [] $ do
-        opts <- options cmd
+        opts <- options $ arguments cmd
-        return [y | (x,y) <- opts, null x || x == "a"]
+        return [y | (x,(_, y)) <- opts, null x || x == "a"]
 
     check cmd = mapM_ warning $ getVars cmd
     warning t = sequence_ $ do
@@ -1070,8 +1097,8 @@ prop_checkSudoArgs7 = verifyNot checkSudoArgs "sudo docker export foo"
 checkSudoArgs = CommandCheck (Basename "sudo") f
   where
     f t = sequence_ $ do
-        opts <- parseOpts t
+        opts <- parseOpts $ arguments t
-        let nonFlags = [x | ("",x) <- opts]
+        let nonFlags = [x | ("",(x, _)) <- opts]
         commandArg <- nonFlags !!! 0
         command <- getLiteralString commandArg
         guard $ command `elem` builtins