diff --git a/src/ShellCheck/AST.hs b/src/ShellCheck/AST.hs index 8a6d7b2..aedb148 100644 --- a/src/ShellCheck/AST.hs +++ b/src/ShellCheck/AST.hs @@ -139,6 +139,7 @@ data Token = | T_CoProcBody Id Token | T_Include Id Token | T_SourceCommand Id Token Token + | T_BatsTest Id Token Token deriving (Show) data Annotation = @@ -276,6 +277,7 @@ analyze f g i = delve (T_CoProcBody id t) = d1 t $ T_CoProcBody id delve (T_Include id script) = d1 script $ T_Include id delve (T_SourceCommand id includer t_include) = d2 includer t_include $ T_SourceCommand id + delve (T_BatsTest id name t) = d2 name t $ T_BatsTest id delve t = return t getId :: Token -> Id @@ -380,6 +382,7 @@ getId t = case t of T_UnparsedIndex id _ _ -> id TC_Empty id _ -> id TA_Variable id _ _ -> id + T_BatsTest id _ _ -> id blank :: Monad m => Token -> m () blank = const $ return () diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 6230f5b..e057449 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -232,7 +232,9 @@ hasFloatingPoint params = shellType params == Ksh isCondition [] = False isCondition [_] = False isCondition (child:parent:rest) = - getId child `elem` map getId (getConditionChildren parent) || isCondition (parent:rest) + case child of + T_BatsTest {} -> True -- count anything in a @test as conditional + _ -> getId child `elem` map getId (getConditionChildren parent) || isCondition (parent:rest) where getConditionChildren t = case t of @@ -1580,6 +1582,7 @@ prop_subshellAssignmentCheck16 = verifyNotTree subshellAssignmentCheck "(set -e) prop_subshellAssignmentCheck17 = verifyNotTree subshellAssignmentCheck "foo=${ { bar=$(baz); } 2>&1; }; echo $foo $bar" prop_subshellAssignmentCheck18 = verifyTree subshellAssignmentCheck "( exec {n}>&2; ); echo $n" prop_subshellAssignmentCheck19 = verifyNotTree subshellAssignmentCheck "#!/bin/bash\nshopt -s lastpipe; echo a | read -r b; echo \"$b\"" +prop_subshellAssignmentCheck20 = verifyTree subshellAssignmentCheck "@test 'foo' { a=1; }\n@test 'bar' { echo $a; }\n" subshellAssignmentCheck params t = let flow = variableFlow params check = findSubshelled flow [("oops",[])] Map.empty @@ -1666,6 +1669,7 @@ prop_checkSpacefulness33= verifyTree checkSpacefulness "for file; do echo $file; prop_checkSpacefulness34= verifyTree checkSpacefulness "declare foo$n=$1" prop_checkSpacefulness35= verifyNotTree checkSpacefulness "echo ${1+\"$1\"}" prop_checkSpacefulness36= verifyNotTree checkSpacefulness "arg=$#; echo $arg" +prop_checkSpacefulness37= verifyNotTree checkSpacefulness "@test 'status' {\n [ $status -eq 0 ]\n}" checkSpacefulness params t = doVariableFlowAnalysis readF writeF (Map.fromList defaults) (variableFlow params) @@ -1891,6 +1895,7 @@ prop_checkUnused37= verifyNotTree checkUnusedAssignments "fd=2; exec {fd}>&-" prop_checkUnused38= verifyTree checkUnusedAssignments "(( a=42 ))" prop_checkUnused39= verifyNotTree checkUnusedAssignments "declare -x -f foo" prop_checkUnused40= verifyNotTree checkUnusedAssignments "arr=(1 2); num=2; echo \"${arr[@]:num}\"" +prop_checkUnused41= verifyNotTree checkUnusedAssignments "@test 'foo' {\ntrue\n}\n" checkUnusedAssignments params t = execWriter (mapM_ warnFor unused) where flow = variableFlow params diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 37a96ad..e0c07f4 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -423,6 +423,7 @@ getVariableFlow params t = assignFirst T_ForIn {} = True assignFirst T_SelectIn {} = True + assignFirst (T_BatsTest {}) = True assignFirst _ = False setRead t = @@ -440,6 +441,7 @@ leadType params t = T_Backticked _ _ -> SubshellScope "`..` expansion" T_Backgrounded _ _ -> SubshellScope "backgrounding &" T_Subshell _ _ -> SubshellScope "(..) group" + T_BatsTest {} -> SubshellScope "@bats test" T_CoProcBody _ _ -> SubshellScope "coproc" T_Redirecting {} -> if fromMaybe False causesSubshell @@ -480,6 +482,12 @@ getModifiedVariables t = guard $ op `elem` ["=", "*=", "/=", "%=", "+=", "-=", "<<=", ">>=", "&=", "^=", "|="] return (t, t, name, DataString $ SourceFrom [rhs]) + T_BatsTest {} -> [ + (t, t, "lines", DataArray SourceExternal), + (t, t, "status", DataString SourceInteger), + (t, t, "output", DataString SourceExternal) + ] + -- Count [[ -v foo ]] as an "assignment". -- This is to prevent [ -v foo ] being unassigned or unused. TC_Unary id _ "-v" token -> maybeToList $ do @@ -699,6 +707,12 @@ getReferencedVariables parents t = then concatMap (getIfReference t) [lhs, rhs] else [] + T_BatsTest {} -> [ -- pretend @test references vars to avoid warnings + (t, t, "lines"), + (t, t, "status"), + (t, t, "output") + ] + t@(T_FdRedirect _ ('{':var) op) -> -- {foo}>&- references and closes foo [(t, t, takeWhile (/= '}') var) | isClosingFileOp op] x -> getReferencedVariableCommand x diff --git a/src/ShellCheck/Data.hs b/src/ShellCheck/Data.hs index 8ce0026..e4ef675 100644 --- a/src/ShellCheck/Data.hs +++ b/src/ShellCheck/Data.hs @@ -109,6 +109,7 @@ shellForExecutable name = case name of "sh" -> return Sh "bash" -> return Bash + "bats" -> return Bash "dash" -> return Dash "ash" -> return Dash -- There's also a warning for this. "ksh" -> return Ksh diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 172ef54..14e31e3 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -2331,6 +2331,17 @@ readBraceGroup = called "brace group" $ do id <- endSpan start return $ T_BraceGroup id list +prop_readBatsTest = isOk readBatsTest "@test 'can parse' {\n true\n}" +readBatsTest = called "bats @test" $ do + start <- startSpan + try $ string "@test" + spacing + name <- readNormalWord + spacing + test <- readBraceGroup + id <- endSpan start + return $ T_BatsTest id name test + prop_readWhileClause = isOk readWhileClause "while [[ -e foo ]]; do sleep 1; done" readWhileClause = called "while loop" $ do start <- startSpan @@ -2590,6 +2601,7 @@ readCompoundCommand = do readForClause, readSelectClause, readCaseClause, + readBatsTest, readFunctionDefinition ] spacing @@ -3037,6 +3049,7 @@ readScriptFile = do "ash", "dash", "bash", + "bats", "ksh" ] badShells = [