From bd9d05c759e9f7cd3d92a2c93456ef6703fd095e Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 27 Dec 2016 21:20:59 -0800 Subject: [PATCH] Warn about missing space in [ foo= bar ] --- ShellCheck/AST.hs | 6 +++--- ShellCheck/ASTLib.hs | 14 ++++++++++++++ ShellCheck/Analytics.hs | 28 ++++++++++++++-------------- ShellCheck/AnalyzerLib.hs | 2 +- ShellCheck/Data.hs | 11 +++++++++++ ShellCheck/Parser.hs | 22 +++++++++++++++++++--- 6 files changed, 62 insertions(+), 21 deletions(-) diff --git a/ShellCheck/AST.hs b/ShellCheck/AST.hs index 37942b9..16309fc 100644 --- a/ShellCheck/AST.hs +++ b/ShellCheck/AST.hs @@ -45,7 +45,7 @@ data Token = | TC_And Id ConditionType String Token Token | TC_Binary Id ConditionType String Token Token | TC_Group Id ConditionType Token - | TC_Noary Id ConditionType Token + | TC_Nullary Id ConditionType Token | TC_Or Id ConditionType String Token Token | TC_Unary Id ConditionType String Token | T_AND_IF Id @@ -258,7 +258,7 @@ analyze f g i = delve (TC_Group id typ token) = d1 token $ TC_Group id typ delve (TC_Binary id typ op lhs rhs) = d2 lhs rhs $ TC_Binary id typ op delve (TC_Unary id typ op token) = d1 token $ TC_Unary id typ op - delve (TC_Noary id typ token) = d1 token $ TC_Noary id typ + delve (TC_Nullary id typ token) = d1 token $ TC_Nullary id typ delve (TA_Binary id op t1 t2) = d2 t1 t2 $ TA_Binary id op delve (TA_Assignment id op t1 t2) = d2 t1 t2 $ TA_Assignment id op @@ -356,7 +356,7 @@ getId t = case t of TC_Group id _ _ -> id TC_Binary id _ _ _ _ -> id TC_Unary id _ _ _ -> id - TC_Noary id _ _ -> id + TC_Nullary id _ _ -> id TA_Binary id _ _ _ -> id TA_Assignment id _ _ _ -> id TA_Unary id _ _ -> id diff --git a/ShellCheck/ASTLib.hs b/ShellCheck/ASTLib.hs index 23bbb98..9bb233c 100644 --- a/ShellCheck/ASTLib.hs +++ b/ShellCheck/ASTLib.hs @@ -171,6 +171,20 @@ getUnquotedLiteral (T_NormalWord _ list) = str _ = Nothing getUnquotedLiteral _ = Nothing +-- Get the last unquoted T_Literal in a word like "${var}foo"THIS +-- or nothing if the word does not end in an unquoted literal. +getTrailingUnquotedLiteral :: Token -> Maybe Token +getTrailingUnquotedLiteral t = + case t of + (T_NormalWord _ list@(_:_)) -> + from (last list) + _ -> Nothing + where + from t = + case t of + (T_Literal {}) -> return t + _ -> Nothing + -- Maybe get the literal string of this token and any globs in it. getGlobOrLiteralString = getLiteralStringExt f where diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs index d60243e..fc7658a 100644 --- a/ShellCheck/Analytics.hs +++ b/ShellCheck/Analytics.hs @@ -98,7 +98,7 @@ nodeChecks = [ ,checkSingleBracketOperators ,checkDoubleBracketOperators ,checkLiteralBreakingTest - ,checkConstantNoary + ,checkConstantNullary ,checkDivBeforeMult ,checkArithmeticDeref ,checkArithmeticBadOctal @@ -1021,7 +1021,7 @@ prop_checkLiteralBreakingTest8 = verifyNot checkLiteralBreakingTest "[ $(true)$( prop_checkLiteralBreakingTest10 = verify checkLiteralBreakingTest "[ -z foo ]" checkLiteralBreakingTest _ t = potentially $ case t of - (TC_Noary _ _ w@(T_NormalWord _ l)) -> do + (TC_Nullary _ _ w@(T_NormalWord _ l)) -> do guard . not $ isConstant w -- Covered by SC2078 comparisonWarning l `mplus` tautologyWarning w "Argument to implicit -n is always true due to literal strings." (TC_Unary _ _ op w@(T_NormalWord _ l)) -> @@ -1045,14 +1045,14 @@ checkLiteralBreakingTest _ t = potentially $ token <- listToMaybe $ filter isNonEmpty $ getWordParts t return $ err (getId token) 2157 s -prop_checkConstantNoary = verify checkConstantNoary "[[ '$(foo)' ]]" -prop_checkConstantNoary2 = verify checkConstantNoary "[ \"-f lol\" ]" -prop_checkConstantNoary3 = verify checkConstantNoary "[[ cmd ]]" -prop_checkConstantNoary4 = verify checkConstantNoary "[[ ! cmd ]]" -prop_checkConstantNoary5 = verify checkConstantNoary "[[ true ]]" -prop_checkConstantNoary6 = verify checkConstantNoary "[ 1 ]" -prop_checkConstantNoary7 = verify checkConstantNoary "[ false ]" -checkConstantNoary _ (TC_Noary _ _ t) | isConstant t = +prop_checkConstantNullary = verify checkConstantNullary "[[ '$(foo)' ]]" +prop_checkConstantNullary2 = verify checkConstantNullary "[ \"-f lol\" ]" +prop_checkConstantNullary3 = verify checkConstantNullary "[[ cmd ]]" +prop_checkConstantNullary4 = verify checkConstantNullary "[[ ! cmd ]]" +prop_checkConstantNullary5 = verify checkConstantNullary "[[ true ]]" +prop_checkConstantNullary6 = verify checkConstantNullary "[ 1 ]" +prop_checkConstantNullary7 = verify checkConstantNullary "[ false ]" +checkConstantNullary _ (TC_Nullary _ _ t) | isConstant t = case fromMaybe "" $ getLiteralString t of "false" -> err (getId t) 2158 "[ false ] is true. Remove the brackets." "0" -> err (getId t) 2159 "[ 0 ] is true. Use 'false' instead." @@ -1062,7 +1062,7 @@ checkConstantNoary _ (TC_Noary _ _ t) | isConstant t = where string = fromMaybe "" $ getLiteralString t -checkConstantNoary _ _ = return () +checkConstantNullary _ _ = return () prop_checkForDecimals1 = verify checkForDecimals "((3.14*c))" prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar" @@ -1180,10 +1180,10 @@ prop_checkValidCondOps2a= verifyNot checkValidCondOps "[ 3 \\> 2 ]" prop_checkValidCondOps3 = verifyNot checkValidCondOps "[ 1 = 2 -a 3 -ge 4 ]" prop_checkValidCondOps4 = verifyNot checkValidCondOps "[[ ! -v foo ]]" checkValidCondOps _ (TC_Binary id _ s _ _) - | s `notElem` ["-nt", "-ot", "-ef", "==", "!=", "<=", ">=", "-eq", "-ne", "-lt", "-le", "-gt", "-ge", "=~", ">", "<", "=", "\\<", "\\>", "\\<=", "\\>="] = + | s `notElem` binaryTestOps = warn id 2057 "Unknown binary operator." checkValidCondOps _ (TC_Unary id _ s _) - | s `notElem` [ "!", "-a", "-b", "-c", "-d", "-e", "-f", "-g", "-h", "-L", "-k", "-p", "-r", "-s", "-S", "-t", "-u", "-w", "-x", "-O", "-G", "-N", "-z", "-n", "-o", "-v", "-R"] = + | s `notElem` unaryTestOps = warn id 2058 "Unknown unary operator." checkValidCondOps _ _ = return () @@ -2362,7 +2362,7 @@ prop_checkGrepQ5= verifyNot checkShouldUseGrepQ "rm $(ls | grep file)" prop_checkGrepQ6= verifyNot checkShouldUseGrepQ "[[ -n $(pgrep foo) ]]" checkShouldUseGrepQ params t = potentially $ case t of - TC_Noary id _ token -> check id True token + TC_Nullary id _ token -> check id True token TC_Unary id _ "-n" token -> check id True token TC_Unary id _ "-z" token -> check id False token _ -> fail "not check" diff --git a/ShellCheck/AnalyzerLib.hs b/ShellCheck/AnalyzerLib.hs index 5aaf8b0..ca357e2 100644 --- a/ShellCheck/AnalyzerLib.hs +++ b/ShellCheck/AnalyzerLib.hs @@ -217,7 +217,7 @@ isQuoteFreeNode strict tree t = -- Are any subnodes inherently self-quoting? isQuoteFreeContext t = case t of - TC_Noary _ DoubleBracket _ -> return True + TC_Nullary _ DoubleBracket _ -> return True TC_Unary _ DoubleBracket _ _ -> return True TC_Binary _ DoubleBracket _ _ _ -> return True TA_Sequence {} -> return True diff --git a/ShellCheck/Data.hs b/ShellCheck/Data.hs index 9f070ad..9cdf734 100644 --- a/ShellCheck/Data.hs +++ b/ShellCheck/Data.hs @@ -85,6 +85,17 @@ sampleWords = [ "zulu" ] +binaryTestOps = [ + "-nt", "-ot", "-ef", "==", "!=", "<=", ">=", "-eq", "-ne", "-lt", "-le", + "-gt", "-ge", "=~", ">", "<", "=", "\\<", "\\>", "\\<=", "\\>=" + ] + +unaryTestOps = [ + "!", "-a", "-b", "-c", "-d", "-e", "-f", "-g", "-h", "-L", "-k", "-p", + "-r", "-s", "-S", "-t", "-u", "-w", "-x", "-O", "-G", "-N", "-z", "-n", + "-o", "-v", "-R" + ] + shellForExecutable :: String -> Maybe Shell shellForExecutable name = case name of diff --git a/ShellCheck/Parser.hs b/ShellCheck/Parser.hs index f97cddf..7db6f4b 100644 --- a/ShellCheck/Parser.hs +++ b/ShellCheck/Parser.hs @@ -333,6 +333,13 @@ parseProblemAtWithEnd start end level code msg = do parseProblemAt pos = parseProblemAtWithEnd pos pos +parseProblemAtId :: Monad m => Id -> Severity -> Integer -> String -> SCParser m () +parseProblemAtId id level code msg = do + map <- getMap + let pos = Map.findWithDefault + (error "Internal error (no position for id). Please report.") id map + parseProblemAt pos level code msg + -- Store non-parse problems inside parseNote c l a = do @@ -528,7 +535,7 @@ readConditionContents single = condSpacing requiresSpacing return x - readCondNoaryOrBinary = do + readCondNullaryOrBinary = do id <- getNextId x <- readCondWord `attempting` (do pos <- getPosition @@ -545,7 +552,16 @@ readConditionContents single = then readRegex else readCondWord <|> (parseProblemAt pos ErrorC 1027 "Expected another argument for this operator." >> mzero) return (x `op` y) - ) <|> return (TC_Noary id typ x) + ) <|> ( do + checkTrailingOp x + return $ TC_Nullary id typ x + ) + + checkTrailingOp x = fromMaybe (return ()) $ do + (T_Literal id str) <- getTrailingUnquotedLiteral x + trailingOp <- listToMaybe (filter (`isSuffixOf` str) binaryTestOps) + return $ parseProblemAtId id ErrorC 1108 $ + "You need a space before and after the " ++ trailingOp ++ " ." readCondGroup = do id <- getNextId @@ -622,7 +638,7 @@ readConditionContents single = return $ TC_Unary id typ "!" expr readCondExpr = - readCondGroup <|> readCondUnaryExp <|> readCondNoaryOrBinary + readCondGroup <|> readCondUnaryExp <|> readCondNullaryOrBinary readCondOr = chainl1 readCondAnd readCondAndOp readCondAnd = chainl1 readCondTerm readCondOrOp