Allow comments after shellcheck directives.

This commit is contained in:
Vidar Holen 2017-05-21 13:56:22 -07:00
parent d943ef6f77
commit 5099ebf9b9
2 changed files with 71 additions and 21 deletions

View File

@ -72,11 +72,11 @@ composeAnalyzers :: (a -> Analysis) -> (a -> Analysis) -> a -> Analysis
composeAnalyzers f g x = f x >> g x composeAnalyzers f g x = f x >> g x
data Parameters = Parameters { data Parameters = Parameters {
variableFlow :: [StackData], variableFlow :: [StackData], -- A linear (bad) analysis of data flow
parentMap :: Map.Map Id Token, parentMap :: Map.Map Id Token, -- A map from Id to parent Token
shellType :: Shell, shellType :: Shell, -- The shell type, such as Bash or Ksh
shellTypeSpecified :: Bool, shellTypeSpecified :: Bool, -- True if shell type was forced via flags
rootNode :: Token rootNode :: Token -- The root node of the AST
} }
-- TODO: Cache results of common AST ops here -- TODO: Cache results of common AST ops here
@ -184,8 +184,10 @@ executableFromShebang = shellFor
shellFor s = reverse . takeWhile (/= '/') . reverse $ s shellFor s = reverse . takeWhile (/= '/') . reverse $ s
--- Context seeking
-- Given a root node, make a map from Id to parent Token.
-- This is used to populate parentMap in Parameters
getParentTree :: Token -> Map.Map Id Token
getParentTree t = getParentTree t =
snd . snd $ runState (doStackAnalysis pre post t) ([], Map.empty) snd . snd $ runState (doStackAnalysis pre post t) ([], Map.empty)
where where
@ -195,18 +197,24 @@ getParentTree t =
case rest of [] -> put (rest, map) case rest of [] -> put (rest, map)
(x:_) -> put (rest, Map.insert (getId t) x map) (x:_) -> put (rest, Map.insert (getId t) x map)
-- Given a root node, make a map from Id to Token
getTokenMap :: Token -> Map.Map Id Token
getTokenMap t = getTokenMap t =
execState (doAnalysis f t) Map.empty execState (doAnalysis f t) Map.empty
where where
f t = modify (Map.insert (getId t) t) f t = modify (Map.insert (getId t) t)
-- Is this node self quoting for a regular element? -- Is this token in a quoting free context? (i.e. would variable expansion split)
isQuoteFree = isQuoteFreeNode False -- True: Assignments, [[ .. ]], here docs, already in double quotes
-- False: Regular words
-- Is this node striclty self quoting, for array expansions
isStrictlyQuoteFree = isQuoteFreeNode True isStrictlyQuoteFree = isQuoteFreeNode True
-- Like above, but also allow some cases where splitting may be desired.
-- True: Like above + for loops
-- False: Like above
isQuoteFree = isQuoteFreeNode False
isQuoteFreeNode strict tree t = isQuoteFreeNode strict tree t =
(isQuoteFreeElement t == Just True) || (isQuoteFreeElement t == Just True) ||
@ -239,6 +247,9 @@ isQuoteFreeNode strict tree t =
T_SelectIn {} -> return (not strict) T_SelectIn {} -> return (not strict)
_ -> Nothing _ -> Nothing
-- Check if a token is a parameter to a certain command by name:
-- Example: isParamTo (parentMap params) "sed" t
isParamTo :: Map.Map Id Token -> String -> Token -> Bool
isParamTo tree cmd = isParamTo tree cmd =
go go
where where
@ -254,16 +265,20 @@ isParamTo tree cmd =
T_Redirecting {} -> isCommand t cmd T_Redirecting {} -> isCommand t cmd
_ -> False _ -> False
-- Get the parent command (T_Redirecting) of a Token, if any.
getClosestCommand :: Map.Map Id Token -> Token -> Maybe Token
getClosestCommand tree t = getClosestCommand tree t =
msum . map getCommand $ getPath tree t msum . map getCommand $ getPath tree t
where where
getCommand t@T_Redirecting {} = return t getCommand t@T_Redirecting {} = return t
getCommand _ = Nothing getCommand _ = Nothing
-- Like above, if koala_man knew Haskell when starting this project.
getClosestCommandM t = do getClosestCommandM t = do
tree <- asks parentMap tree <- asks parentMap
return $ getClosestCommand tree t return $ getClosestCommand tree t
-- Is the token used as a command name (the first word in a T_SimpleCommand)?
usedAsCommandName tree token = go (getId token) (tail $ getPath tree token) usedAsCommandName tree token = go (getId token) (tail $ getPath tree token)
where where
go currentId (T_NormalWord id [word]:rest) go currentId (T_NormalWord id [word]:rest)
@ -274,7 +289,7 @@ usedAsCommandName tree token = go (getId token) (tail $ getPath tree token)
| currentId == getId word = True | currentId == getId word = True
go _ _ = False go _ _ = False
-- A list of the element and all its parents -- A list of the element and all its parents up to the root node.
getPath tree t = t : getPath tree t = t :
case Map.lookup (getId t) tree of case Map.lookup (getId t) tree of
Nothing -> [] Nothing -> []
@ -623,13 +638,20 @@ dataTypeFrom defaultType v = (case v of T_Array {} -> DataArray; _ -> defaultTyp
--- Command specific checks --- Command specific checks
-- Compare a command to a string: t `isCommand` "sed" (also matches /usr/bin/sed)
isCommand token str = isCommandMatch token (\cmd -> cmd == str || ('/' : str) `isSuffixOf` cmd) isCommand token str = isCommandMatch token (\cmd -> cmd == str || ('/' : str) `isSuffixOf` cmd)
-- Compare a command to a literal. Like above, but checks full path.
isUnqualifiedCommand token str = isCommandMatch token (== str) isUnqualifiedCommand token str = isCommandMatch token (== str)
isCommandMatch token matcher = fromMaybe False $ do isCommandMatch token matcher = fromMaybe False $ do
cmd <- getCommandName token cmd <- getCommandName token
return $ matcher cmd return $ matcher cmd
-- Does this regex look like it was intended as a glob?
-- True: *foo*
-- False: .*foo.*
isConfusedGlobRegex :: String -> Bool
isConfusedGlobRegex ('*':_) = True isConfusedGlobRegex ('*':_) = True
isConfusedGlobRegex [x,'*'] | x /= '\\' = True isConfusedGlobRegex [x,'*'] | x /= '\\' = True
isConfusedGlobRegex _ = False isConfusedGlobRegex _ = False
@ -656,6 +678,7 @@ getVariablesFromLiteral string =
where where
variableRegex = mkRegex "\\$\\{?([A-Za-z0-9_]+)" variableRegex = mkRegex "\\$\\{?([A-Za-z0-9_]+)"
-- Get the variable name from an expansion like ${var:-foo}
prop_getBracedReference1 = getBracedReference "foo" == "foo" prop_getBracedReference1 = getBracedReference "foo" == "foo"
prop_getBracedReference2 = getBracedReference "#foo" == "foo" prop_getBracedReference2 = getBracedReference "#foo" == "foo"
prop_getBracedReference3 = getBracedReference "#" == "#" prop_getBracedReference3 = getBracedReference "#" == "#"
@ -706,13 +729,22 @@ getBracedModifier s = fromMaybe "" . listToMaybe $ do
dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest] dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest]
dropModifier x = [x] dropModifier x = [x]
-- Useful generic functions -- Useful generic functions.
-- Run an action in a Maybe (or do nothing).
-- Example:
-- potentially $ do
-- s <- getLiteralString cmd
-- guard $ s `elem` ["--recursive", "-r"]
-- return $ warn .. "Something something recursive"
potentially :: Monad m => Maybe (m ()) -> m () potentially :: Monad m => Maybe (m ()) -> m ()
potentially = fromMaybe (return ()) potentially = fromMaybe (return ())
-- Get element 0 or a default. Like `head` but safe.
headOrDefault _ (a:_) = a headOrDefault _ (a:_) = a
headOrDefault def _ = def headOrDefault def _ = def
--- Get element n of a list, or Nothing. Like `!!` but safe.
(!!!) list i = (!!!) list i =
case drop i list of case drop i list of
[] -> Nothing [] -> Nothing

View File

@ -889,10 +889,13 @@ prop_readAnnotation1 = isOk readAnnotation "# shellcheck disable=1234,5678\n"
prop_readAnnotation2 = isOk readAnnotation "# shellcheck disable=SC1234 disable=SC5678\n" prop_readAnnotation2 = isOk readAnnotation "# shellcheck disable=SC1234 disable=SC5678\n"
prop_readAnnotation3 = isOk readAnnotation "# shellcheck disable=SC1234 source=/dev/null disable=SC5678\n" prop_readAnnotation3 = isOk readAnnotation "# shellcheck disable=SC1234 source=/dev/null disable=SC5678\n"
prop_readAnnotation4 = isWarning readAnnotation "# shellcheck cats=dogs disable=SC1234\n" prop_readAnnotation4 = isWarning readAnnotation "# shellcheck cats=dogs disable=SC1234\n"
prop_readAnnotation5 = isOk readAnnotation "# shellcheck disable=SC2002 # All cats are precious\n"
prop_readAnnotation6 = isOk readAnnotation "# shellcheck disable=SC1234 # shellcheck foo=bar\n"
readAnnotation = called "shellcheck annotation" $ do readAnnotation = called "shellcheck annotation" $ do
try readAnnotationPrefix try readAnnotationPrefix
many1 linewhitespace many1 linewhitespace
values <- many1 (readDisable <|> readSourceOverride <|> readShellOverride <|> anyKey) values <- many1 (readDisable <|> readSourceOverride <|> readShellOverride <|> anyKey)
optional readAnyComment
linefeed linefeed
many linewhitespace many linewhitespace
return $ concat values return $ concat values
@ -926,7 +929,8 @@ readAnnotation = called "shellcheck annotation" $ do
anyKey = do anyKey = do
pos <- getPosition pos <- getPosition
anyChar `reluctantlyTill1` whitespace noneOf "#\r\n"
anyChar `reluctantlyTill` whitespace
many linewhitespace many linewhitespace
parseNoteAt pos WarningC 1107 "This directive is unknown. It will be ignored." parseNoteAt pos WarningC 1107 "This directive is unknown. It will be ignored."
return [] return []
@ -937,6 +941,9 @@ readAnnotations = do
readComment = do readComment = do
unexpecting "shellcheck annotation" readAnnotationPrefix unexpecting "shellcheck annotation" readAnnotationPrefix
readAnyComment
readAnyComment = do
char '#' char '#'
many $ noneOf "\r\n" many $ noneOf "\r\n"
@ -2729,14 +2736,18 @@ readScript = do
script <- readScriptFile script <- readScriptFile
reparseIndices script reparseIndices script
isWarning p s = parsesCleanly p s == Just False
isOk p s = parsesCleanly p s == Just True
isNotOk p s = parsesCleanly p s == Nothing
testParse string = runIdentity $ do -- Interactively run a parser in ghci:
(res, _) <- runParser (mockedSystemInterface []) readScript "-" string -- debugParse readScript "echo 'hello world'"
debugParse p string = runIdentity $ do
(res, _) <- runParser (mockedSystemInterface []) p "-" string
return res return res
isOk p s = parsesCleanly p s == Just True -- The string parses with no warnings
isWarning p s = parsesCleanly p s == Just False -- The string parses with warnings
isNotOk p s = parsesCleanly p s == Nothing -- The string does not parse
parsesCleanly parser string = runIdentity $ do parsesCleanly parser string = runIdentity $ do
(res, sys) <- runParser (mockedSystemInterface []) (res, sys) <- runParser (mockedSystemInterface [])
(parser >> eof >> getState) "-" string (parser >> eof >> getState) "-" string
@ -2745,6 +2756,16 @@ parsesCleanly parser string = runIdentity $ do
return $ Just . null $ parseNotes userState ++ parseProblems systemState return $ Just . null $ parseNotes userState ++ parseProblems systemState
(Left _, _) -> return Nothing (Left _, _) -> return Nothing
-- For printf debugging: print the value of an expression
-- Example: return $ dump $ T_Literal id [c]
dump :: Show a => a -> a
dump x = trace (show x) x
-- Like above, but print a specific expression:
-- Example: return $ dumps ("Returning: " ++ [c]) $ T_Literal id [c]
dumps :: Show x => x -> a -> a
dumps t = trace (show t)
parseWithNotes parser = do parseWithNotes parser = do
item <- parser item <- parser
state <- getState state <- getState
@ -2877,9 +2898,6 @@ parseScript sys spec =
parseShell sys (psFilename spec) (psScript spec) parseShell sys (psFilename spec) (psScript spec)
lt x = trace (show x) x
ltt t = trace (show t)
return [] return []
runTests = $quickCheckAll runTests = $quickCheckAll