Warnings for braces/globs/arrays in [/[[.

This commit is contained in:
Vidar Holen 2016-12-31 13:18:36 -08:00
parent 0048f34b11
commit 6aee12a572
2 changed files with 65 additions and 8 deletions

View File

@ -276,6 +276,8 @@ isOnlyRedirection t =
isFunction t = case t of T_Function {} -> True; _ -> False isFunction t = case t of T_Function {} -> True; _ -> False
isBraceExpansion t = case t of T_BraceExpansion {} -> True; _ -> False
-- Get the lists of commands from tokens that contain them, such as -- Get the lists of commands from tokens that contain them, such as
-- the body of while loops or branches of if statements. -- the body of while loops or branches of if statements.
getCommandSequences t = getCommandSequences t =

View File

@ -149,7 +149,7 @@ nodeChecks = [
,checkMultipleAppends ,checkMultipleAppends
,checkSuspiciousIFS ,checkSuspiciousIFS
,checkShouldUseGrepQ ,checkShouldUseGrepQ
,checkTestGlobs ,checkTestArgumentSplitting
,checkConcatenatedDollarAt ,checkConcatenatedDollarAt
,checkTildeInPath ,checkTildeInPath
,checkMaskedReturns ,checkMaskedReturns
@ -1145,7 +1145,7 @@ checkComparisonAgainstGlob _ (TC_Binary _ DoubleBracket op _ (T_NormalWord id [T
warn id 2053 $ "Quote the rhs of " ++ op ++ " in [[ ]] to prevent glob matching." warn id 2053 $ "Quote the rhs of " ++ op ++ " in [[ ]] to prevent glob matching."
checkComparisonAgainstGlob _ (TC_Binary _ SingleBracket op _ word) checkComparisonAgainstGlob _ (TC_Binary _ SingleBracket op _ word)
| (op == "=" || op == "==") && isGlob word = | (op == "=" || op == "==") && isGlob word =
err (getId word) 2081 "[ .. ] can't match globs. Use [[ .. ]] or grep." err (getId word) 2081 "[ .. ] can't match globs. Use [[ .. ]] or case statement."
checkComparisonAgainstGlob _ _ = return () checkComparisonAgainstGlob _ _ = return ()
prop_checkCommarrays1 = verify checkCommarrays "a=(1, 2)" prop_checkCommarrays1 = verify checkCommarrays "a=(1, 2)"
@ -2398,12 +2398,67 @@ checkShouldUseGrepQ params t =
_ -> fail "unknown" _ -> fail "unknown"
isGrep = (`elem` ["grep", "egrep", "fgrep", "zgrep"]) isGrep = (`elem` ["grep", "egrep", "fgrep", "zgrep"])
prop_checkTestGlobs1 = verify checkTestGlobs "[ -e *.mp3 ]" prop_checkTestArgumentSplitting1 = verify checkTestArgumentSplitting "[ -e *.mp3 ]"
prop_checkTestGlobs2 = verifyNot checkTestGlobs "[[ $a == *b* ]]" prop_checkTestArgumentSplitting2 = verifyNot checkTestArgumentSplitting "[[ $a == *b* ]]"
checkTestGlobs params (TC_Unary _ _ op token) | isGlob token = prop_checkTestArgumentSplitting3 = verify checkTestArgumentSplitting "[[ *.png == '' ]]"
err (getId token) 2144 $ prop_checkTestArgumentSplitting4 = verify checkTestArgumentSplitting "[[ foo == f{o,oo,ooo} ]]"
op ++ " doesn't work with globs. Use a for loop." prop_checkTestArgumentSplitting5 = verify checkTestArgumentSplitting "[[ $@ ]]"
checkTestGlobs _ _ = return () prop_checkTestArgumentSplitting6 = verify checkTestArgumentSplitting "[ -e $@ ]"
prop_checkTestArgumentSplitting7 = verify checkTestArgumentSplitting "[ $@ == $@ ]"
prop_checkTestArgumentSplitting8 = verify checkTestArgumentSplitting "[[ $@ = $@ ]]"
prop_checkTestArgumentSplitting9 = verifyNot checkTestArgumentSplitting "[[ foo =~ bar{1,2} ]]"
prop_checkTestArgumentSplitting10 = verifyNot checkTestArgumentSplitting "[ \"$@\" ]"
prop_checkTestArgumentSplitting11 = verify checkTestArgumentSplitting "[[ \"$@\" ]]"
prop_checkTestArgumentSplitting12 = verify checkTestArgumentSplitting "[ *.png ]"
prop_checkTestArgumentSplitting13 = verify checkTestArgumentSplitting "[ \"$@\" == \"\" ]"
prop_checkTestArgumentSplitting14 = verify checkTestArgumentSplitting "[[ \"$@\" == \"\" ]]"
prop_checkTestArgumentSplitting15 = verifyNot checkTestArgumentSplitting "[[ \"$*\" == \"\" ]]"
checkTestArgumentSplitting :: Parameters -> Token -> Writer [TokenComment] ()
checkTestArgumentSplitting _ t =
case t of
(TC_Unary _ _ op token) | isGlob token ->
err (getId token) 2144 $
op ++ " doesn't work with globs. Use a for loop."
(TC_Nullary _ typ token) -> do
checkBraces typ token
checkGlobs typ token
when (typ == DoubleBracket) $
checkArrays typ token
(TC_Unary _ typ op token) -> checkAll typ token
(TC_Binary _ typ op lhs rhs) ->
if op `elem` ["=", "==", "!=", "=~"]
then do
checkAll typ lhs
checkArrays typ rhs
checkBraces typ rhs
else mapM_ (checkAll typ) [lhs, rhs]
_ -> return ()
where
checkAll typ token = do
checkArrays typ token
checkBraces typ token
checkGlobs typ token
checkArrays typ token =
when (any isArrayExpansion $ getWordParts token) $
if typ == SingleBracket
then warn (getId token) 2198 "Arrays don't work as operands in [ ]. Use a loop (or concatenate with * instead of @)."
else err (getId token) 2199 "Arrays implicitly concatenate in [[ ]]. Use a loop (or explicit * instead of @)."
checkBraces typ token =
when (any isBraceExpansion $ getWordParts token) $
if typ == SingleBracket
then warn (getId token) 2200 "Brace expansions don't work as operands in [ ]. Use a loop."
else err (getId token) 2201 "Brace expansion doesn't happen in [[ ]]. Use a loop."
checkGlobs typ token =
when (isGlob token) $
if typ == SingleBracket
then warn (getId token) 2202 "Globs don't work as operands in [ ]. Use a loop."
else err (getId token) 2203 "Globs are ignored in [[ ]] except right of =/!=. Use a loop."
prop_checkMaskedReturns1 = verify checkMaskedReturns "f() { local a=$(false); }" prop_checkMaskedReturns1 = verify checkMaskedReturns "f() { local a=$(false); }"