From 08f7ff37c590f8aa6dba6d989d707aad4adc5f4c Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 12 Nov 2016 15:51:36 -0800 Subject: [PATCH] Some cleanup and refactoring. --- ShellCheck.cabal | 1 + ShellCheck/AST.hs | 5 +- ShellCheck/Analytics.hs | 353 +-------------------------- ShellCheck/Analyzer.hs | 10 +- ShellCheck/AnalyzerLib.hs | 61 ++++- ShellCheck/Checks/Commands.hs | 90 +++++-- ShellCheck/Checks/ShellSupport.hs | 384 ++++++++++++++++++++++++++++++ quicktest | 1 + test/shellcheck.hs | 2 + 9 files changed, 525 insertions(+), 382 deletions(-) create mode 100644 ShellCheck/Checks/ShellSupport.hs diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 4bc7e1f..d6fea1b 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -55,6 +55,7 @@ library ShellCheck.AnalyzerLib ShellCheck.Checker ShellCheck.Checks.Commands + ShellCheck.Checks.ShellSupport ShellCheck.Data ShellCheck.Formatter.Format ShellCheck.Formatter.CheckStyle diff --git a/ShellCheck/AST.hs b/ShellCheck/AST.hs index 209667f..28dffc8 100644 --- a/ShellCheck/AST.hs +++ b/ShellCheck/AST.hs @@ -33,6 +33,7 @@ data FunctionKeyword = FunctionKeyword Bool deriving (Show, Eq) data FunctionParentheses = FunctionParentheses Bool deriving (Show, Eq) data CaseType = CaseBreak | CaseFallThrough | CaseContinue deriving (Show, Eq) +data Root = Root Token data Token = TA_Binary Id String Token Token | TA_Assignment Id String Token Token @@ -376,7 +377,7 @@ getId t = case t of blank :: Monad m => Token -> m () blank = const $ return () -doAnalysis f = analyze f blank (return . id) -doStackAnalysis startToken endToken = analyze startToken endToken (return . id) +doAnalysis f = analyze f blank return +doStackAnalysis startToken endToken = analyze startToken endToken return doTransform i = runIdentity . analyze blank blank (return . i) diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs index d34a1e8..c44e91f 100644 --- a/ShellCheck/Analytics.hs +++ b/ShellCheck/Analytics.hs @@ -22,7 +22,7 @@ module ShellCheck.Analytics (runAnalytics, ShellCheck.Analytics.runTests) where import ShellCheck.AST import ShellCheck.ASTLib -import ShellCheck.AnalyzerLib +import ShellCheck.AnalyzerLib hiding (producesComments) import ShellCheck.Data import ShellCheck.Parser import ShellCheck.Interface @@ -50,7 +50,7 @@ treeChecks :: [Parameters -> Token -> [TokenComment]] treeChecks = [ runNodeAnalysis (\p t -> (mapM_ ((\ f -> f t) . (\ f -> f p)) - (nodeChecks ++ checksFor (shellType p)))) + nodeChecks)) ,subshellAssignmentCheck ,checkSpacefulness ,checkQuotesInLiterals @@ -64,30 +64,6 @@ treeChecks = [ ,checkUncheckedCd ] -checksFor Sh = [ - checkBashisms - ,checkTimeParameters - ,checkForDecimals - ,checkTimedCommand - ] -checksFor Dash = [ - checkBashisms - ,checkForDecimals - ,checkLocalScope - ,checkTimedCommand - ] -checksFor Ksh = [ - checkEchoSed - ] -checksFor Bash = [ - checkTimeParameters - ,checkBraceExpansionVars - ,checkEchoSed - ,checkForDecimals - ,checkLocalScope - ,checkMultiDimensionalArrays - ] - runAnalytics :: AnalysisSpec -> [TokenComment] runAnalytics options = runList options treeChecks @@ -264,30 +240,6 @@ checkEchoWc _ (T_Pipeline id _ [a, b]) = countMsg = style id 2000 "See if you can use ${#variable} instead." checkEchoWc _ _ = return () -prop_checkEchoSed1 = verify checkEchoSed "FOO=$(echo \"$cow\" | sed 's/foo/bar/g')" -prop_checkEchoSed2 = verify checkEchoSed "rm $(echo $cow | sed -e 's,foo,bar,')" -checkEchoSed _ (T_Pipeline id _ [a, b]) = - when (acmd == ["echo", "${VAR}"]) $ - case bcmd of - ["sed", v] -> checkIn v - ["sed", "-e", v] -> checkIn v - _ -> return () - where - -- This should have used backreferences, but TDFA doesn't support them - sedRe = mkRegex "^s(.)([^\n]*)g?$" - isSimpleSed s = fromMaybe False $ do - [first,rest] <- matchRegex sedRe s - let delimiters = filter (== (head first)) rest - guard $ length delimiters == 2 - return True - - acmd = oversimplify a - bcmd = oversimplify b - checkIn s = - when (isSimpleSed s) $ - style id 2001 "See if you can use ${variable//search/replace} instead." -checkEchoSed _ _ = return () - prop_checkPipedAssignment1 = verify checkPipedAssignment "A=ls | grep foo" prop_checkPipedAssignment2 = verifyNot checkPipedAssignment "A=foo cmd | grep foo" prop_checkPipedAssignment3 = verifyNot checkPipedAssignment "A=foo" @@ -458,224 +410,6 @@ checkShebang params (T_Script id sb _) = "Tips depend on target shell and yours is unknown. Add a shebang." | not (shellTypeSpecified params) && sb == "" ] -prop_checkBashisms = verify checkBashisms "while read a; do :; done < <(a)" -prop_checkBashisms2 = verify checkBashisms "[ foo -nt bar ]" -prop_checkBashisms3 = verify checkBashisms "echo $((i++))" -prop_checkBashisms4 = verify checkBashisms "rm !(*.hs)" -prop_checkBashisms5 = verify checkBashisms "source file" -prop_checkBashisms6 = verify checkBashisms "[ \"$a\" == 42 ]" -prop_checkBashisms7 = verify checkBashisms "echo ${var[1]}" -prop_checkBashisms8 = verify checkBashisms "echo ${!var[@]}" -prop_checkBashisms9 = verify checkBashisms "echo ${!var*}" -prop_checkBashisms10= verify checkBashisms "echo ${var:4:12}" -prop_checkBashisms11= verifyNot checkBashisms "echo ${var:-4}" -prop_checkBashisms12= verify checkBashisms "echo ${var//foo/bar}" -prop_checkBashisms13= verify checkBashisms "exec -c env" -prop_checkBashisms14= verify checkBashisms "echo -n \"Foo: \"" -prop_checkBashisms15= verify checkBashisms "let n++" -prop_checkBashisms16= verify checkBashisms "echo $RANDOM" -prop_checkBashisms17= verify checkBashisms "echo $((RANDOM%6+1))" -prop_checkBashisms18= verify checkBashisms "foo &> /dev/null" -prop_checkBashisms19= verify checkBashisms "foo > file*.txt" -prop_checkBashisms20= verify checkBashisms "read -ra foo" -prop_checkBashisms21= verify checkBashisms "[ -a foo ]" -prop_checkBashisms22= verifyNot checkBashisms "[ foo -a bar ]" -prop_checkBashisms23= verify checkBashisms "trap mything ERR INT" -prop_checkBashisms24= verifyNot checkBashisms "trap mything INT TERM" -prop_checkBashisms25= verify checkBashisms "cat < /dev/tcp/host/123" -prop_checkBashisms26= verify checkBashisms "trap mything ERR SIGTERM" -prop_checkBashisms27= verify checkBashisms "echo *[^0-9]*" -prop_checkBashisms28= verify checkBashisms "exec {n}>&2" -prop_checkBashisms29= verify checkBashisms "echo ${!var}" -prop_checkBashisms30= verify checkBashisms "printf -v '%s' \"$1\"" -prop_checkBashisms31= verify checkBashisms "printf '%q' \"$1\"" -prop_checkBashisms32= verifyNot checkBashisms "#!/bin/dash\n[ foo -nt bar ]" -prop_checkBashisms33= verify checkBashisms "#!/bin/sh\necho -n foo" -prop_checkBashisms34= verifyNot checkBashisms "#!/bin/dash\necho -n foo" -prop_checkBashisms35= verifyNot checkBashisms "#!/bin/dash\nlocal foo" -prop_checkBashisms36= verifyNot checkBashisms "#!/bin/dash\nread -p foo -r bar" -prop_checkBashisms37= verifyNot checkBashisms "HOSTNAME=foo; echo $HOSTNAME" -prop_checkBashisms38= verify checkBashisms "RANDOM=9; echo $RANDOM" -prop_checkBashisms39= verify checkBashisms "foo-bar() { true; }" -prop_checkBashisms40= verify checkBashisms "echo $(/dev/null" -prop_checkBashisms48= verifyNot checkBashisms "#!/bin/dash\necho $LINENO" -prop_checkBashisms49= verify checkBashisms "#!/bin/dash\necho $MACHTYPE" -prop_checkBashisms50= verify checkBashisms "#!/bin/sh\ncmd >& file" -prop_checkBashisms51= verifyNot checkBashisms "#!/bin/sh\ncmd 2>&1" -prop_checkBashisms52= verifyNot checkBashisms "#!/bin/sh\ncmd >&2" -checkBashisms params = bashism - where - isDash = shellType params == Dash - warnMsg id s = - if isDash - then warn id 2169 $ "In dash, " ++ s ++ " not supported." - else warn id 2039 $ "In POSIX sh, " ++ s ++ " undefined." - - bashism (T_ProcSub id _ _) = warnMsg id "process substitution is" - bashism (T_Extglob id _ _) = warnMsg id "extglob is" - bashism (T_DollarSingleQuoted id _) = warnMsg id "$'..' is" - bashism (T_DollarDoubleQuoted id _) = warnMsg id "$\"..\" is" - bashism (T_ForArithmetic id _ _ _ _) = warnMsg id "arithmetic for loops are" - bashism (T_Arithmetic id _) = warnMsg id "standalone ((..)) is" - bashism (T_DollarBracket id _) = warnMsg id "$[..] in place of $((..)) is" - bashism (T_SelectIn id _ _ _) = warnMsg id "select loops are" - bashism (T_BraceExpansion id _) = warnMsg id "brace expansion is" - bashism (T_Condition id DoubleBracket _) = warnMsg id "[[ ]] is" - bashism (T_HereString id _) = warnMsg id "here-strings are" - bashism (TC_Binary id SingleBracket op _ _) - | op `elem` [ "-nt", "-ef", "\\<", "\\>"] = - unless isDash $ warnMsg id $ op ++ " is" - bashism (TC_Binary id SingleBracket "==" _ _) = - warnMsg id "== in place of = is" - bashism (TC_Unary id _ "-a" _) = - warnMsg id "unary -a in place of -e is" - bashism (TA_Unary id op _) - | op `elem` [ "|++", "|--", "++|", "--|"] = - warnMsg id $ filter (/= '|') op ++ " is" - bashism (TA_Binary id "**" _ _) = warnMsg id "exponentials are" - bashism (T_FdRedirect id "&" (T_IoFile _ (T_Greater _) _)) = warnMsg id "&> is" - bashism (T_FdRedirect id "" (T_IoFile _ (T_GREATAND _) _)) = warnMsg id ">& is" - bashism (T_FdRedirect id ('{':_) _) = warnMsg id "named file descriptors are" - bashism (T_FdRedirect id num _) - | all isDigit num && length num > 1 = warnMsg id "FDs outside 0-9 are" - bashism (T_IoFile id _ word) | isNetworked = - warnMsg id "/dev/{tcp,udp} is" - where - file = onlyLiteralString word - isNetworked = any (`isPrefixOf` file) ["/dev/tcp", "/dev/udp"] - bashism (T_Glob id str) | "[^" `isInfixOf` str = - warnMsg id "^ in place of ! in glob bracket expressions is" - - bashism t@(TA_Expansion id _) | isBashism = - warnMsg id $ fromJust str ++ " is" - where - str = getLiteralString t - isBashism = isJust str && isBashVariable (fromJust str) - bashism t@(T_DollarBraced id token) = do - mapM_ check expansion - when (isBashVariable var) $ - warnMsg id $ var ++ " is" - where - str = bracedString t - var = getBracedReference str - check (regex, feature) = - when (isJust $ matchRegex regex str) $ warnMsg id feature - - bashism t@(T_Pipe id "|&") = - warnMsg id "|& in place of 2>&1 | is" - bashism (T_Array id _) = - warnMsg id "arrays are" - bashism (T_IoFile id _ t) | isGlob t = - warnMsg id "redirecting to/from globs is" - bashism (T_CoProc id _ _) = - warnMsg id "coproc is" - - bashism (T_Function id _ _ str _) | not (isVariableName str) = - warnMsg id "naming functions outside [a-zA-Z_][a-zA-Z0-9_]* is" - - bashism (T_DollarExpansion id [x]) | isOnlyRedirection x = - warnMsg id "$( (not . null . snd $ x) && snd x `notElem` allowed) flags - return . warnMsg (getId word) $ name ++ " -" ++ flag ++ " is" - - when (name == "source") $ warnMsg id "'source' in place of '.' is" - when (name == "trap") $ - let - check token = potentially $ do - str <- getLiteralString token - let upper = map toUpper str - return $ do - when (upper `elem` ["ERR", "DEBUG", "RETURN"]) $ - warnMsg (getId token) $ "trapping " ++ str ++ " is" - when ("SIG" `isPrefixOf` upper) $ - warnMsg (getId token) - "prefixing signal names with 'SIG' is" - when (not isDash && upper /= str) $ - warnMsg (getId token) - "using lower/mixed case for signal names is" - in - mapM_ check (drop 1 rest) - - when (name == "printf") $ potentially $ do - format <- rest !!! 0 -- flags are covered by allowedFlags - let literal = onlyLiteralString format - guard $ "%q" `isInfixOf` literal - return $ warnMsg (getId format) "printf %q is" - where - unsupportedCommands = [ - "let", "caller", "builtin", "complete", "compgen", "declare", "dirs", "disown", - "enable", "mapfile", "readarray", "pushd", "popd", "shopt", "suspend", - "typeset" - ] ++ if not isDash then ["local", "type"] else [] - allowedFlags = Map.fromList [ - ("read", if isDash then ["r", "p"] else ["r"]), - ("ulimit", ["f"]), - ("printf", []), - ("exec", []) - ] - - bashism _ = return () - - varChars="_0-9a-zA-Z" - expansion = let re = mkRegex in [ - (re $ "^![" ++ varChars ++ "]", "indirect expansion is"), - (re $ "^[" ++ varChars ++ "]+\\[.*\\]$", "array references are"), - (re $ "^![" ++ varChars ++ "]+\\[[*@]]$", "array key expansion is"), - (re $ "^![" ++ varChars ++ "]+[*@]$", "name matching prefixes are"), - (re $ "^[" ++ varChars ++ "]+:[^-=?+]", "string indexing is"), - (re $ "^[" ++ varChars ++ "]+(\\[.*\\])?/", "string replacement is") - ] - bashVars = [ - "LINENO", "OSTYPE", "MACHTYPE", "HOSTTYPE", "HOSTNAME", - "DIRSTACK", "EUID", "UID", "SHLVL", "PIPESTATUS", "SHELLOPTS" - ] - bashDynamicVars = [ "RANDOM", "SECONDS" ] - dashVars = [ "LINENO" ] - isBashVariable var = - (var `elem` bashDynamicVars - || var `elem` bashVars && not (isAssigned var)) - && not (isDash && var `elem` dashVars) - isAssigned var = any f (variableFlow params) - where - f x = case x of - Assignment (_, _, name, _) -> name == var - _ -> False - prop_checkForInQuoted = verify checkForInQuoted "for f in \"$(ls)\"; do echo foo; done" prop_checkForInQuoted2 = verifyNot checkForInQuoted "for f in \"$@\"; do echo foo; done" @@ -1324,28 +1058,6 @@ checkConstantNoary _ (TC_Noary _ _ t) | isConstant t = checkConstantNoary _ _ = return () -prop_checkBraceExpansionVars1 = verify checkBraceExpansionVars "echo {1..$n}" -prop_checkBraceExpansionVars2 = verifyNot checkBraceExpansionVars "echo {1,3,$n}" -prop_checkBraceExpansionVars3 = verify checkBraceExpansionVars "eval echo DSC{0001..$n}.jpg" -prop_checkBraceExpansionVars4 = verify checkBraceExpansionVars "echo {$i..100}" -checkBraceExpansionVars params t@(T_BraceExpansion id list) = mapM_ check list - where - check element = - when (any (`isInfixOf` toString element) ["$..", "..$"]) $ - if isEvaled - then style id 2175 "Quote this invalid brace expansion since it should be passed literally to eval." - else warn id 2051 "Bash doesn't support variables in brace range expansions." - literalExt t = - case t of - T_DollarBraced {} -> return "$" - T_DollarExpansion {} -> return "$" - T_DollarArithmetic {} -> return "$" - otherwise -> return "-" - toString t = fromJust $ getLiteralStringExt literalExt t - isEvaled = fromMaybe False $ - (`isUnqualifiedCommand` "eval") <$> getClosestCommand (parentMap params) t -checkBraceExpansionVars _ _ = return () - prop_checkForDecimals1 = verify checkForDecimals "((3.14*c))" prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar" prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=bar" @@ -1503,40 +1215,6 @@ checkUuoeVar _ p = "Useless echo? Instead of 'cmd $(echo foo)', just use 'cmd foo'." otherwise -> return () -prop_checkTimeParameters1 = verify checkTimeParameters "time -f lol sleep 10" -prop_checkTimeParameters2 = verifyNot checkTimeParameters "time sleep 10" -prop_checkTimeParameters3 = verifyNot checkTimeParameters "time -p foo" -checkTimeParameters _ = checkUnqualifiedCommand "time" f where - f cmd (x:_) = let s = concat $ oversimplify x in - when ("-" `isPrefixOf` s && s /= "-p") $ - info (getId cmd) 2023 "The shell may override 'time' as seen in man time(1). Use 'command time ..' for that one." - f _ _ = return () - -prop_checkTimedCommand1 = verify checkTimedCommand "time -p foo | bar" -prop_checkTimedCommand2 = verify checkTimedCommand "time ( foo; bar; )" -prop_checkTimedCommand3 = verifyNot checkTimedCommand "time sleep 1" -checkTimedCommand _ = checkUnqualifiedCommand "time" f where - f c args@(_:_) = do - let cmd = last args - when (isPiped cmd) $ - warn (getId c) 2176 "'time' is undefined for pipelines. time single stage or bash -c instead." - when (isSimple cmd == Just False) $ - warn (getId cmd) 2177 "'time' is undefined for compound commands, time sh -c instead." - f _ _ = return () - isPiped cmd = - case cmd of - T_Pipeline _ _ (_:_:_) -> True - _ -> False - getCommand cmd = - case cmd of - T_Pipeline _ _ ((T_Redirecting _ _ a):_) -> return a - _ -> fail "" - isSimple cmd = do - innerCommand <- getCommand cmd - case innerCommand of - T_SimpleCommand {} -> return True - _ -> return False - prop_checkTestRedirects1 = verify checkTestRedirects "test 3 > 1" prop_checkTestRedirects2 = verifyNot checkTestRedirects "test 3 \\> 1" @@ -2386,14 +2064,6 @@ checkLoopKeywordScope params t | checkLoopKeywordScope _ _ = return () -prop_checkLocalScope1 = verify checkLocalScope "local foo=3" -prop_checkLocalScope2 = verifyNot checkLocalScope "f() { local foo=3; }" -checkLocalScope params t | t `isCommand` "local" && not (isInFunction t) = - err (getId t) 2168 "'local' is only valid in functions." - where - isInFunction t = any isFunction $ getPath (parentMap params) t -checkLocalScope _ _ = return () - prop_checkFunctionDeclarations1 = verify checkFunctionDeclarations "#!/bin/ksh\nfunction foo() { command foo --lol \"$@\"; }" prop_checkFunctionDeclarations2 = verify checkFunctionDeclarations "#!/bin/dash\nfunction foo { lol; }" prop_checkFunctionDeclarations3 = verifyNot checkFunctionDeclarations "foo() { echo bar; }" @@ -2823,25 +2493,6 @@ checkTrailingBracket _ token = "]" -> "[" x -> x -prop_checkMultiDimensionalArrays1 = verify checkMultiDimensionalArrays "foo[a][b]=3" -prop_checkMultiDimensionalArrays2 = verifyNot checkMultiDimensionalArrays "foo[a]=3" -prop_checkMultiDimensionalArrays3 = verify checkMultiDimensionalArrays "foo=( [a][b]=c )" -prop_checkMultiDimensionalArrays4 = verifyNot checkMultiDimensionalArrays "foo=( [a]=c )" -prop_checkMultiDimensionalArrays5 = verify checkMultiDimensionalArrays "echo ${foo[bar][baz]}" -prop_checkMultiDimensionalArrays6 = verifyNot checkMultiDimensionalArrays "echo ${foo[bar]}" -checkMultiDimensionalArrays _ token = - case token of - T_Assignment _ _ name (first:second:_) _ -> about second - T_IndexedElement _ (first:second:_) _ -> about second - T_DollarBraced {} -> - when (isMultiDim token) $ about token - _ -> return () - where - about t = warn (getId t) 2180 "Bash does not support multidimensional arrays. Use 1D or associative arrays." - - re = mkRegex "^\\[.*\\]\\[.*\\]" -- Fixme, this matches ${foo:- [][]} and such as well - isMultiDim t = getBracedModifier (bracedString t) `matches` re - prop_checkReturnAgainstZero1 = verify checkReturnAgainstZero "[ $? -eq 0 ]" prop_checkReturnAgainstZero2 = verify checkReturnAgainstZero "[[ \"$?\" -gt 0 ]]" prop_checkReturnAgainstZero3 = verify checkReturnAgainstZero "[[ 0 -ne $? ]]" diff --git a/ShellCheck/Analyzer.hs b/ShellCheck/Analyzer.hs index 7e70cc7..968c0fc 100644 --- a/ShellCheck/Analyzer.hs +++ b/ShellCheck/Analyzer.hs @@ -24,6 +24,7 @@ import ShellCheck.AnalyzerLib import ShellCheck.Interface import Data.List import qualified ShellCheck.Checks.Commands +import qualified ShellCheck.Checks.ShellSupport -- TODO: Clean up the cruft this is layered on @@ -32,5 +33,12 @@ analyzeScript spec = AnalysisResult { arComments = filterByAnnotation (asScript spec) . nub $ runAnalytics spec - ++ ShellCheck.Checks.Commands.runChecks spec + ++ runChecker params (checkers params) } + where + params = makeParameters spec + +checkers params = mconcat $ map ($ params) [ + ShellCheck.Checks.Commands.checker, + ShellCheck.Checks.ShellSupport.checker + ] diff --git a/ShellCheck/AnalyzerLib.hs b/ShellCheck/AnalyzerLib.hs index 9c3a527..469bfed 100644 --- a/ShellCheck/AnalyzerLib.hs +++ b/ShellCheck/AnalyzerLib.hs @@ -29,7 +29,7 @@ import ShellCheck.Regex import Control.Arrow (first) import Control.Monad.Identity -import Control.Monad.Reader +import Control.Monad.RWS import Control.Monad.State import Control.Monad.Writer import Data.Char @@ -40,16 +40,48 @@ import qualified Data.Map as Map import Test.QuickCheck.All (forAllProperties) import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) -type Analysis = ReaderT Parameters (Writer [TokenComment]) () +type Analysis = AnalyzerM () +type AnalyzerM a = RWS Parameters [TokenComment] Cache a +nullCheck = const $ return () +data Checker = Checker { + perScript :: Root -> Analysis, + perToken :: Token -> Analysis +} + +runChecker :: Parameters -> Checker -> [TokenComment] +runChecker params checker = notes + where + root = rootNode params + check = perScript checker `composeAnalyzers` (\(Root x) -> void $ doAnalysis (perToken checker) x) + notes = snd $ evalRWS (check $ Root root) params Cache + +instance Monoid Checker where + mempty = Checker { + perScript = nullCheck, + perToken = nullCheck + } + mappend x y = Checker { + perScript = perScript x `composeAnalyzers` perScript y, + perToken = perToken x `composeAnalyzers` perToken y + } + + +composeAnalyzers :: (a -> Analysis) -> (a -> Analysis) -> a -> Analysis +composeAnalyzers f g x = f x >> g x + data Parameters = Parameters { variableFlow :: [StackData], parentMap :: Map.Map Id Token, shellType :: Shell, - shellTypeSpecified :: Bool + shellTypeSpecified :: Bool, + rootNode :: Token } +-- TODO: Cache results of common AST ops here +data Cache = Cache {} + data Scope = SubshellScope String | NoneScope deriving (Show, Eq) data StackData = StackScope Scope @@ -81,6 +113,14 @@ pScript s = } in prRoot . runIdentity $ parseScript (mockedSystemInterface []) pSpec +-- For testing. If parsed, returns whether there are any comments +producesComments :: Checker -> String -> Maybe Bool +producesComments c s = do + root <- pScript s + let spec = defaultSpec root + let params = makeParameters spec + return . not . null $ runChecker params c + makeComment :: Severity -> Id -> Code -> String -> TokenComment makeComment severity id code note = TokenComment id $ Comment severity code note @@ -95,6 +135,7 @@ style id code str = addComment $ makeComment StyleC id code str makeParameters spec = let params = Parameters { + rootNode = root, shellType = fromMaybe (determineShell root) $ asShellType spec, shellTypeSpecified = isJust $ asShellType spec, parentMap = getParentTree root, @@ -211,6 +252,10 @@ getClosestCommand tree t = getCommand t@(T_Redirecting {}) = return t getCommand _ = Nothing +getClosestCommandM t = do + tree <- asks parentMap + return $ getClosestCommand tree t + usedAsCommandName tree token = go (getId token) (tail $ getPath tree token) where go currentId (T_NormalWord id [word]:rest) @@ -227,6 +272,12 @@ getPath tree t = t : Nothing -> [] Just parent -> getPath tree parent +-- Version of the above taking the map from the current context +-- Todo: give this the name "getPath" +getPathM t = do + map <- asks parentMap + return $ getPath map t + isParentOf tree parent child = elem (getId parent) . map getId $ getPath tree child @@ -644,6 +695,10 @@ headOrDefault def _ = def [] -> Nothing (r:_) -> Just r +-- Run a command if the shell is in the given list +whenShell l c = do + shell <- asks shellType + when (shell `elem` l ) c filterByAnnotation token = diff --git a/ShellCheck/Checks/Commands.hs b/ShellCheck/Checks/Commands.hs index dccd275..e51f794 100644 --- a/ShellCheck/Checks/Commands.hs +++ b/ShellCheck/Checks/Commands.hs @@ -21,7 +21,7 @@ {-# LANGUAGE FlexibleContexts #-} -- This module contains checks that examine specific commands by name. -module ShellCheck.Checks.Commands (runChecks +module ShellCheck.Checks.Commands (checker , ShellCheck.Checks.Commands.runTests ) where @@ -34,8 +34,7 @@ import ShellCheck.Parser import ShellCheck.Regex import Control.Monad -import Control.Monad.Reader -import Control.Monad.Writer +import Control.Monad.RWS import Data.Char import Data.List import Data.Maybe @@ -49,22 +48,10 @@ data CommandName = Exactly String | Basename String data CommandCheck = CommandCheck CommandName (Token -> Analysis) -nullCheck :: Token -> Analysis -nullCheck _ = return () - verify :: CommandCheck -> String -> Bool -verify f s = producesComments f s == Just True -verifyNot f s = producesComments f s == Just False - -producesComments :: CommandCheck -> String -> Maybe Bool -producesComments f s = do - root <- pScript s - return . not . null $ runList (defaultSpec root) [f] - -composeChecks f g t = do - f t - g t +verify f s = producesComments (getChecker [f]) s == Just True +verifyNot f s = producesComments (getChecker [f]) s == Just False arguments (T_SimpleCommand _ _ (cmd:args)) = args @@ -92,13 +79,16 @@ commandChecks = [ ,checkAliasesExpandEarly ,checkUnsetGlobs ,checkFindWithoutPath + ,checkTimeParameters + ,checkTimedCommand + ,checkLocalScope ] buildCommandMap :: [CommandCheck] -> Map.Map CommandName (Token -> Analysis) buildCommandMap = foldl' addCheck Map.empty where addCheck map (CommandCheck name function) = - Map.insertWith' composeChecks name function map + Map.insertWith' composeAnalyzers name function map checkCommand :: Map.Map CommandName (Token -> Analysis) -> Token -> Analysis @@ -116,15 +106,17 @@ checkCommand map t@(T_SimpleCommand id _ (cmd:rest)) = fromMaybe (return ()) $ d basename = reverse . takeWhile (/= '/') . reverse checkCommand _ _ = return () -runList spec list = notes - where - root = asScript spec - params = makeParameters spec - notes = execWriter $ runReaderT (doAnalysis (checkCommand map) root) params - map = buildCommandMap list +getChecker :: [CommandCheck] -> Checker +getChecker list = Checker { + perScript = const $ return (), + perToken = checkCommand map + } + where + map = buildCommandMap list -runChecks spec = runList spec commandChecks +checker :: Parameters -> Checker +checker params = getChecker commandChecks prop_checkTr1 = verify checkTr "tr [a-f] [A-F]" prop_checkTr2 = verify checkTr "tr 'a-z' 'A-Z'" @@ -619,5 +611,53 @@ checkFindWithoutPath = CommandCheck (Basename "find") f hasPath [] = False +prop_checkTimeParameters1 = verify checkTimeParameters "time -f lol sleep 10" +prop_checkTimeParameters2 = verifyNot checkTimeParameters "time sleep 10" +prop_checkTimeParameters3 = verifyNot checkTimeParameters "time -p foo" +prop_checkTimeParameters4 = verifyNot checkTimeParameters "command time -f lol sleep 10" +checkTimeParameters = CommandCheck (Exactly "time") f + where + f (T_SimpleCommand _ _ (cmd:args:_)) = + whenShell [Bash, Sh] $ + let s = concat $ oversimplify args in + when ("-" `isPrefixOf` s && s /= "-p") $ + info (getId cmd) 2023 "The shell may override 'time' as seen in man time(1). Use 'command time ..' for that one." + + f _ = return () + +prop_checkTimedCommand1 = verify checkTimedCommand "#!/bin/sh\ntime -p foo | bar" +prop_checkTimedCommand2 = verify checkTimedCommand "#!/bin/dash\ntime ( foo; bar; )" +prop_checkTimedCommand3 = verifyNot checkTimedCommand "#!/bin/sh\ntime sleep 1" +checkTimedCommand = CommandCheck (Exactly "time") f where + f (T_SimpleCommand _ _ (c:args@(_:_))) = + whenShell [Sh, Dash] $ do + let cmd = last args -- "time" is parsed with a command as argument + when (isPiped cmd) $ + warn (getId c) 2176 "'time' is undefined for pipelines. time single stage or bash -c instead." + when (isSimple cmd == Just False) $ + warn (getId cmd) 2177 "'time' is undefined for compound commands, time sh -c instead." + f _ = return () + isPiped cmd = + case cmd of + T_Pipeline _ _ (_:_:_) -> True + _ -> False + getCommand cmd = + case cmd of + T_Pipeline _ _ (T_Redirecting _ _ a : _) -> return a + _ -> fail "" + isSimple cmd = do + innerCommand <- getCommand cmd + case innerCommand of + T_SimpleCommand {} -> return True + _ -> return False + +prop_checkLocalScope1 = verify checkLocalScope "local foo=3" +prop_checkLocalScope2 = verifyNot checkLocalScope "f() { local foo=3; }" +checkLocalScope = CommandCheck (Exactly "local") $ \t -> + whenShell [Bash, Dash] $ do -- Ksh allows it, Sh doesn't support local + path <- getPathM t + unless (any isFunction path) $ + err (getId t) 2168 "'local' is only valid in functions." + return [] runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/ShellCheck/Checks/ShellSupport.hs b/ShellCheck/Checks/ShellSupport.hs new file mode 100644 index 0000000..7e1440b --- /dev/null +++ b/ShellCheck/Checks/ShellSupport.hs @@ -0,0 +1,384 @@ +{- + Copyright 2012-2016 Vidar Holen + + This file is part of ShellCheck. + http://www.vidarholen.net/contents/shellcheck + + ShellCheck is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + ShellCheck is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts #-} +module ShellCheck.Checks.ShellSupport (checker + , ShellCheck.Checks.ShellSupport.runTests +) where + +import ShellCheck.AST +import ShellCheck.ASTLib +import ShellCheck.AnalyzerLib +import ShellCheck.Interface +import ShellCheck.Regex + +import Control.Monad +import Control.Monad.RWS +import Data.Char +import Data.List +import Data.Maybe +import qualified Data.Map as Map +import Test.QuickCheck.All (forAllProperties) +import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) + +data ForShell = ForShell [Shell] (Token -> Analysis) + +getChecker params list = Checker { + perScript = nullCheck, + perToken = foldl composeAnalyzers nullCheck $ mapMaybe include list + } + where + shell = shellType params + include (ForShell list a) = do + guard $ shell `elem` list + return a + +checker params = getChecker params checks + +checks = [ + checkForDecimals + ,checkBashisms + ,checkEchoSed + ,checkBraceExpansionVars + ,checkMultiDimensionalArrays + ] + +testChecker (ForShell _ t) = + Checker { + perScript = nullCheck, + perToken = t + } +verify c s = producesComments (testChecker c) s == Just True +verifyNot c s = producesComments (testChecker c) s == Just False + +prop_checkForDecimals1 = verify checkForDecimals "((3.14*c))" +prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar" +prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=bar" +checkForDecimals = ForShell [Sh, Dash, Bash] f + where + f t@(TA_Expansion id _) = potentially $ do + str <- getLiteralString t + first <- str !!! 0 + guard $ isDigit first && '.' `elem` str + return $ err id 2079 "(( )) doesn't support decimals. Use bc or awk." + f _ = return () + + +prop_checkBashisms = verify checkBashisms "while read a; do :; done < <(a)" +prop_checkBashisms2 = verify checkBashisms "[ foo -nt bar ]" +prop_checkBashisms3 = verify checkBashisms "echo $((i++))" +prop_checkBashisms4 = verify checkBashisms "rm !(*.hs)" +prop_checkBashisms5 = verify checkBashisms "source file" +prop_checkBashisms6 = verify checkBashisms "[ \"$a\" == 42 ]" +prop_checkBashisms7 = verify checkBashisms "echo ${var[1]}" +prop_checkBashisms8 = verify checkBashisms "echo ${!var[@]}" +prop_checkBashisms9 = verify checkBashisms "echo ${!var*}" +prop_checkBashisms10= verify checkBashisms "echo ${var:4:12}" +prop_checkBashisms11= verifyNot checkBashisms "echo ${var:-4}" +prop_checkBashisms12= verify checkBashisms "echo ${var//foo/bar}" +prop_checkBashisms13= verify checkBashisms "exec -c env" +prop_checkBashisms14= verify checkBashisms "echo -n \"Foo: \"" +prop_checkBashisms15= verify checkBashisms "let n++" +prop_checkBashisms16= verify checkBashisms "echo $RANDOM" +prop_checkBashisms17= verify checkBashisms "echo $((RANDOM%6+1))" +prop_checkBashisms18= verify checkBashisms "foo &> /dev/null" +prop_checkBashisms19= verify checkBashisms "foo > file*.txt" +prop_checkBashisms20= verify checkBashisms "read -ra foo" +prop_checkBashisms21= verify checkBashisms "[ -a foo ]" +prop_checkBashisms22= verifyNot checkBashisms "[ foo -a bar ]" +prop_checkBashisms23= verify checkBashisms "trap mything ERR INT" +prop_checkBashisms24= verifyNot checkBashisms "trap mything INT TERM" +prop_checkBashisms25= verify checkBashisms "cat < /dev/tcp/host/123" +prop_checkBashisms26= verify checkBashisms "trap mything ERR SIGTERM" +prop_checkBashisms27= verify checkBashisms "echo *[^0-9]*" +prop_checkBashisms28= verify checkBashisms "exec {n}>&2" +prop_checkBashisms29= verify checkBashisms "echo ${!var}" +prop_checkBashisms30= verify checkBashisms "printf -v '%s' \"$1\"" +prop_checkBashisms31= verify checkBashisms "printf '%q' \"$1\"" +prop_checkBashisms32= verifyNot checkBashisms "#!/bin/dash\n[ foo -nt bar ]" +prop_checkBashisms33= verify checkBashisms "#!/bin/sh\necho -n foo" +prop_checkBashisms34= verifyNot checkBashisms "#!/bin/dash\necho -n foo" +prop_checkBashisms35= verifyNot checkBashisms "#!/bin/dash\nlocal foo" +prop_checkBashisms36= verifyNot checkBashisms "#!/bin/dash\nread -p foo -r bar" +prop_checkBashisms37= verifyNot checkBashisms "HOSTNAME=foo; echo $HOSTNAME" +prop_checkBashisms38= verify checkBashisms "RANDOM=9; echo $RANDOM" +prop_checkBashisms39= verify checkBashisms "foo-bar() { true; }" +prop_checkBashisms40= verify checkBashisms "echo $(/dev/null" +prop_checkBashisms48= verifyNot checkBashisms "#!/bin/dash\necho $LINENO" +prop_checkBashisms49= verify checkBashisms "#!/bin/dash\necho $MACHTYPE" +prop_checkBashisms50= verify checkBashisms "#!/bin/sh\ncmd >& file" +prop_checkBashisms51= verifyNot checkBashisms "#!/bin/sh\ncmd 2>&1" +prop_checkBashisms52= verifyNot checkBashisms "#!/bin/sh\ncmd >&2" +checkBashisms = ForShell [Sh, Dash] $ \t -> do + params <- ask + kludge params t + where + -- This code was copy-pasted from Analytics where params was a variable + kludge params = bashism + where + isDash = shellType params == Dash + warnMsg id s = + if isDash + then warn id 2169 $ "In dash, " ++ s ++ " not supported." + else warn id 2039 $ "In POSIX sh, " ++ s ++ " undefined." + + bashism (T_ProcSub id _ _) = warnMsg id "process substitution is" + bashism (T_Extglob id _ _) = warnMsg id "extglob is" + bashism (T_DollarSingleQuoted id _) = warnMsg id "$'..' is" + bashism (T_DollarDoubleQuoted id _) = warnMsg id "$\"..\" is" + bashism (T_ForArithmetic id _ _ _ _) = warnMsg id "arithmetic for loops are" + bashism (T_Arithmetic id _) = warnMsg id "standalone ((..)) is" + bashism (T_DollarBracket id _) = warnMsg id "$[..] in place of $((..)) is" + bashism (T_SelectIn id _ _ _) = warnMsg id "select loops are" + bashism (T_BraceExpansion id _) = warnMsg id "brace expansion is" + bashism (T_Condition id DoubleBracket _) = warnMsg id "[[ ]] is" + bashism (T_HereString id _) = warnMsg id "here-strings are" + bashism (TC_Binary id SingleBracket op _ _) + | op `elem` [ "-nt", "-ef", "\\<", "\\>"] = + unless isDash $ warnMsg id $ op ++ " is" + bashism (TC_Binary id SingleBracket "==" _ _) = + warnMsg id "== in place of = is" + bashism (TC_Unary id _ "-a" _) = + warnMsg id "unary -a in place of -e is" + bashism (TA_Unary id op _) + | op `elem` [ "|++", "|--", "++|", "--|"] = + warnMsg id $ filter (/= '|') op ++ " is" + bashism (TA_Binary id "**" _ _) = warnMsg id "exponentials are" + bashism (T_FdRedirect id "&" (T_IoFile _ (T_Greater _) _)) = warnMsg id "&> is" + bashism (T_FdRedirect id "" (T_IoFile _ (T_GREATAND _) _)) = warnMsg id ">& is" + bashism (T_FdRedirect id ('{':_) _) = warnMsg id "named file descriptors are" + bashism (T_FdRedirect id num _) + | all isDigit num && length num > 1 = warnMsg id "FDs outside 0-9 are" + bashism (T_IoFile id _ word) | isNetworked = + warnMsg id "/dev/{tcp,udp} is" + where + file = onlyLiteralString word + isNetworked = any (`isPrefixOf` file) ["/dev/tcp", "/dev/udp"] + bashism (T_Glob id str) | "[^" `isInfixOf` str = + warnMsg id "^ in place of ! in glob bracket expressions is" + + bashism t@(TA_Expansion id _) | isBashism = + warnMsg id $ fromJust str ++ " is" + where + str = getLiteralString t + isBashism = isJust str && isBashVariable (fromJust str) + bashism t@(T_DollarBraced id token) = do + mapM_ check expansion + when (isBashVariable var) $ + warnMsg id $ var ++ " is" + where + str = bracedString t + var = getBracedReference str + check (regex, feature) = + when (isJust $ matchRegex regex str) $ warnMsg id feature + + bashism t@(T_Pipe id "|&") = + warnMsg id "|& in place of 2>&1 | is" + bashism (T_Array id _) = + warnMsg id "arrays are" + bashism (T_IoFile id _ t) | isGlob t = + warnMsg id "redirecting to/from globs is" + bashism (T_CoProc id _ _) = + warnMsg id "coproc is" + + bashism (T_Function id _ _ str _) | not (isVariableName str) = + warnMsg id "naming functions outside [a-zA-Z_][a-zA-Z0-9_]* is" + + bashism (T_DollarExpansion id [x]) | isOnlyRedirection x = + warnMsg id "$( (not . null . snd $ x) && snd x `notElem` allowed) flags + return . warnMsg (getId word) $ name ++ " -" ++ flag ++ " is" + + when (name == "source") $ warnMsg id "'source' in place of '.' is" + when (name == "trap") $ + let + check token = potentially $ do + str <- getLiteralString token + let upper = map toUpper str + return $ do + when (upper `elem` ["ERR", "DEBUG", "RETURN"]) $ + warnMsg (getId token) $ "trapping " ++ str ++ " is" + when ("SIG" `isPrefixOf` upper) $ + warnMsg (getId token) + "prefixing signal names with 'SIG' is" + when (not isDash && upper /= str) $ + warnMsg (getId token) + "using lower/mixed case for signal names is" + in + mapM_ check (drop 1 rest) + + when (name == "printf") $ potentially $ do + format <- rest !!! 0 -- flags are covered by allowedFlags + let literal = onlyLiteralString format + guard $ "%q" `isInfixOf` literal + return $ warnMsg (getId format) "printf %q is" + where + unsupportedCommands = [ + "let", "caller", "builtin", "complete", "compgen", "declare", "dirs", "disown", + "enable", "mapfile", "readarray", "pushd", "popd", "shopt", "suspend", + "typeset" + ] ++ if not isDash then ["local", "type"] else [] + allowedFlags = Map.fromList [ + ("read", if isDash then ["r", "p"] else ["r"]), + ("ulimit", ["f"]), + ("printf", []), + ("exec", []) + ] + + bashism _ = return () + + varChars="_0-9a-zA-Z" + expansion = let re = mkRegex in [ + (re $ "^![" ++ varChars ++ "]", "indirect expansion is"), + (re $ "^[" ++ varChars ++ "]+\\[.*\\]$", "array references are"), + (re $ "^![" ++ varChars ++ "]+\\[[*@]]$", "array key expansion is"), + (re $ "^![" ++ varChars ++ "]+[*@]$", "name matching prefixes are"), + (re $ "^[" ++ varChars ++ "]+:[^-=?+]", "string indexing is"), + (re $ "^[" ++ varChars ++ "]+(\\[.*\\])?/", "string replacement is") + ] + bashVars = [ + "LINENO", "OSTYPE", "MACHTYPE", "HOSTTYPE", "HOSTNAME", + "DIRSTACK", "EUID", "UID", "SHLVL", "PIPESTATUS", "SHELLOPTS" + ] + bashDynamicVars = [ "RANDOM", "SECONDS" ] + dashVars = [ "LINENO" ] + isBashVariable var = + (var `elem` bashDynamicVars + || var `elem` bashVars && not (isAssigned var)) + && not (isDash && var `elem` dashVars) + isAssigned var = any f (variableFlow params) + where + f x = case x of + Assignment (_, _, name, _) -> name == var + _ -> False + +prop_checkEchoSed1 = verify checkEchoSed "FOO=$(echo \"$cow\" | sed 's/foo/bar/g')" +prop_checkEchoSed2 = verify checkEchoSed "rm $(echo $cow | sed -e 's,foo,bar,')" +checkEchoSed = ForShell [Bash, Ksh] f + where + f (T_Pipeline id _ [a, b]) = + when (acmd == ["echo", "${VAR}"]) $ + case bcmd of + ["sed", v] -> checkIn v + ["sed", "-e", v] -> checkIn v + _ -> return () + where + -- This should have used backreferences, but TDFA doesn't support them + sedRe = mkRegex "^s(.)([^\n]*)g?$" + isSimpleSed s = fromMaybe False $ do + [first,rest] <- matchRegex sedRe s + let delimiters = filter (== head first) rest + guard $ length delimiters == 2 + return True + + acmd = oversimplify a + bcmd = oversimplify b + checkIn s = + when (isSimpleSed s) $ + style id 2001 "See if you can use ${variable//search/replace} instead." + f _ = return () + + +prop_checkBraceExpansionVars1 = verify checkBraceExpansionVars "echo {1..$n}" +prop_checkBraceExpansionVars2 = verifyNot checkBraceExpansionVars "echo {1,3,$n}" +prop_checkBraceExpansionVars3 = verify checkBraceExpansionVars "eval echo DSC{0001..$n}.jpg" +prop_checkBraceExpansionVars4 = verify checkBraceExpansionVars "echo {$i..100}" +checkBraceExpansionVars = ForShell [Bash] f + where + f t@(T_BraceExpansion id list) = mapM_ check list + where + check element = + when (any (`isInfixOf` toString element) ["$..", "..$"]) $ do + c <- isEvaled element + if c + then style id 2175 "Quote this invalid brace expansion since it should be passed literally to eval." + else warn id 2051 "Bash doesn't support variables in brace range expansions." + f _ = return () + + literalExt t = + case t of + T_DollarBraced {} -> return "$" + T_DollarExpansion {} -> return "$" + T_DollarArithmetic {} -> return "$" + otherwise -> return "-" + toString t = fromJust $ getLiteralStringExt literalExt t + isEvaled t = do + cmd <- getClosestCommandM t + return $ isJust cmd && fromJust cmd `isUnqualifiedCommand` "eval" + + +prop_checkMultiDimensionalArrays1 = verify checkMultiDimensionalArrays "foo[a][b]=3" +prop_checkMultiDimensionalArrays2 = verifyNot checkMultiDimensionalArrays "foo[a]=3" +prop_checkMultiDimensionalArrays3 = verify checkMultiDimensionalArrays "foo=( [a][b]=c )" +prop_checkMultiDimensionalArrays4 = verifyNot checkMultiDimensionalArrays "foo=( [a]=c )" +prop_checkMultiDimensionalArrays5 = verify checkMultiDimensionalArrays "echo ${foo[bar][baz]}" +prop_checkMultiDimensionalArrays6 = verifyNot checkMultiDimensionalArrays "echo ${foo[bar]}" +checkMultiDimensionalArrays = ForShell [Bash] f + where + f token = + case token of + T_Assignment _ _ name (first:second:_) _ -> about second + T_IndexedElement _ (first:second:_) _ -> about second + T_DollarBraced {} -> + when (isMultiDim token) $ about token + _ -> return () + about t = warn (getId t) 2180 "Bash does not support multidimensional arrays. Use 1D or associative arrays." + + re = mkRegex "^\\[.*\\]\\[.*\\]" -- Fixme, this matches ${foo:- [][]} and such as well + isMultiDim t = getBracedModifier (bracedString t) `matches` re + + +return [] +runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |]) diff --git a/quicktest b/quicktest index 60894ab..f4ed0b3 100755 --- a/quicktest +++ b/quicktest @@ -9,6 +9,7 @@ ,ShellCheck.Parser.runTests ,ShellCheck.Checker.runTests ,ShellCheck.Checks.Commands.runTests + ,ShellCheck.Checks.ShellSupport.runTests ,ShellCheck.AnalyzerLib.runTests ]' | tr -d '\n' | cabal repl 2>&1 | tee /dev/stderr) if [[ $var == *$'\nTrue'* ]] diff --git a/test/shellcheck.hs b/test/shellcheck.hs index 6c5c96b..6106d9a 100644 --- a/test/shellcheck.hs +++ b/test/shellcheck.hs @@ -7,12 +7,14 @@ import qualified ShellCheck.Analytics import qualified ShellCheck.AnalyzerLib import qualified ShellCheck.Parser import qualified ShellCheck.Checks.Commands +import qualified ShellCheck.Checks.ShellSupport main = do putStrLn "Running ShellCheck tests..." results <- sequence [ ShellCheck.Checker.runTests, ShellCheck.Checks.Commands.runTests, + ShellCheck.Checks.ShellSupport.runTests, ShellCheck.Analytics.runTests, ShellCheck.AnalyzerLib.runTests, ShellCheck.Parser.runTests