diff --git a/src/ShellCheck/ASTLib.hs b/src/ShellCheck/ASTLib.hs index 6b26b22..1e1b9cd 100644 --- a/src/ShellCheck/ASTLib.hs +++ b/src/ShellCheck/ASTLib.hs @@ -446,6 +446,12 @@ getLiteralStringExt more = g -- Is this token a string literal? isLiteral t = isJust $ getLiteralString t +-- Is this token a string literal number? +isLiteralNumber t = fromMaybe False $ do + s <- getLiteralString t + guard $ all isDigit s + return True + -- Escape user data for messages. -- Messages generally avoid repeating user data, but sometimes it's helpful. e4m = escapeForMessage diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index 073e911..2e9a3bd 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1635,8 +1635,8 @@ checkOrNeq _ (T_OrIf id lhs rhs) = sequence_ $ do checkOrNeq _ _ = return () -prop_checkAndEq1 = verify checkAndEq "if [[ $lol -eq cow && $lol -eq foo ]]; then echo foo; fi" -prop_checkAndEq2 = verify checkAndEq "(( a==lol && a==foo ))" +prop_checkAndEq1 = verifyNot checkAndEq "cow=0; foo=0; if [[ $lol -eq cow && $lol -eq foo ]]; then echo foo; fi" +prop_checkAndEq2 = verifyNot checkAndEq "lol=0 foo=0; (( a==lol && a==foo ))" prop_checkAndEq3 = verify checkAndEq "[ \"$a\" = lol && \"$a\" = foo ]" prop_checkAndEq4 = verifyNot checkAndEq "[ a = $cow && b = $foo ]" prop_checkAndEq5 = verifyNot checkAndEq "[[ $a = /home && $a = */public_html/* ]]" @@ -1644,25 +1644,34 @@ prop_checkAndEq6 = verify checkAndEq "[ $a = a ] && [ $a = b ]" prop_checkAndEq7 = verify checkAndEq "[ $a = a ] && [ $a = b ] || true" prop_checkAndEq8 = verifyNot checkAndEq "[[ $a == x && $a == x ]]" prop_checkAndEq9 = verifyNot checkAndEq "[ 0 -eq $FOO ] && [ 0 -eq $BAR ]" +prop_checkAndEq10 = verify checkAndEq "(( a == 1 && a == 2 ))" +prop_checkAndEq11 = verify checkAndEq "[ $x -eq 1 ] && [ $x -eq 2 ]" +prop_checkAndEq12 = verify checkAndEq "[ 1 -eq $x ] && [ $x -eq 2 ]" +prop_checkAndEq13 = verifyNot checkAndEq "[ 1 -eq $x ] && [ $x -eq 1 ]" +prop_checkAndEq14 = verifyNot checkAndEq "[ $a = $b ] && [ $a = $c ]" + +checkAndEqOperands "-eq" rhs1 rhs2 = isLiteralNumber rhs1 && isLiteralNumber rhs2 +checkAndEqOperands op rhs1 rhs2 | op == "=" || op == "==" = isLiteral rhs1 && isLiteral rhs2 +checkAndEqOperands _ _ _ = False -- For test-level "and": [ x = y -a x = z ] checkAndEq _ (TC_And id typ op (TC_Binary _ _ op1 lhs1 rhs1 ) (TC_Binary _ _ op2 lhs2 rhs2)) - | (op1 == op2 && (op1 == "-eq" || op1 == "=" || op1 == "==")) && lhs1 == lhs2 && rhs1 /= rhs2 && not (any isGlob [rhs1,rhs2]) = - warn id 2055 $ "You probably wanted " ++ (if typ == SingleBracket then "-o" else "||") ++ " here, otherwise it's always false." + | op1 == op2 && lhs1 == lhs2 && rhs1 /= rhs2 && checkAndEqOperands op1 rhs1 rhs2 = + warn id 2333 $ "You probably wanted " ++ (if typ == SingleBracket then "-o" else "||") ++ " here, otherwise it's always false." -- For arithmetic context "and" -checkAndEq _ (TA_Binary id "&&" (TA_Binary _ "==" word1 _) (TA_Binary _ "==" word2 _)) - | word1 == word2 = - warn id 2056 "You probably wanted || here, otherwise it's always false." +checkAndEq _ (TA_Binary id "&&" (TA_Binary _ "==" lhs1 rhs1) (TA_Binary _ "==" lhs2 rhs2)) + | lhs1 == lhs2 && isLiteralNumber rhs1 && isLiteralNumber rhs2 = + warn id 2334 "You probably wanted || here, otherwise it's always false." -- For command level "and": [ x = y ] && [ x = z ] checkAndEq _ (T_AndIf id lhs rhs) = sequence_ $ do (lhs1, op1, rhs1) <- getExpr lhs (lhs2, op2, rhs2) <- getExpr rhs - guard $ op1 == op2 && op1 `elem` ["-eq", "=", "=="] + guard $ op1 == op2 guard $ lhs1 == lhs2 && rhs1 /= rhs2 - guard . not $ any isGlob [rhs1, rhs2] - return $ warn id 2252 "You probably wanted || here, otherwise it's always false." + guard $ checkAndEqOperands op1 rhs1 rhs2 + return $ warn id 2333 "You probably wanted || here, otherwise it's always false." where getExpr x = case x of