SC2323: Warn about redundant parens in a[(x+1)] and $(( ((x)) )) (ref: #1666)

This commit is contained in:
Vidar Holen 2022-07-24 14:06:01 -07:00
parent 30bb0e0093
commit 52dac51cd4
5 changed files with 42 additions and 2 deletions

View file

@ -207,6 +207,7 @@ nodeChecks = [
,checkSpacefulnessCfg
,checkOverwrittenExitCode
,checkUnnecessaryArithmeticExpansionIndex
,checkUnnecessaryParens
]
optionalChecks = map fst optionalTreeChecks
@ -3280,6 +3281,7 @@ checkReturnAgainstZero params token =
_:next@(TA_Unary _ "!" _):_ -> isOnlyTestInCommand next
_:next@(TC_Group {}):_ -> isOnlyTestInCommand next
_:next@(TA_Sequence _ [_]):_ -> isOnlyTestInCommand next
_:next@(TA_Parentesis _ _):_ -> isOnlyTestInCommand next
_ -> False
-- TODO: Do better $? tracking and filter on whether
@ -4931,5 +4933,36 @@ checkUnnecessaryArithmeticExpansionIndex params t =
]
prop_checkUnnecessaryParens1 = verify checkUnnecessaryParens "echo $(( ((1+1)) ))"
prop_checkUnnecessaryParens2 = verify checkUnnecessaryParens "x[((1+1))+1]=1"
prop_checkUnnecessaryParens3 = verify checkUnnecessaryParens "x[(1+1)]=1"
prop_checkUnnecessaryParens4 = verify checkUnnecessaryParens "$(( (x) ))"
prop_checkUnnecessaryParens5 = verify checkUnnecessaryParens "(( (x) ))"
prop_checkUnnecessaryParens6 = verifyNot checkUnnecessaryParens "x[(1+1)+1]=1"
prop_checkUnnecessaryParens7 = verifyNot checkUnnecessaryParens "(( (1*1)+1 ))"
prop_checkUnnecessaryParens8 = verifyNot checkUnnecessaryParens "(( (1)+1 ))"
checkUnnecessaryParens params t =
case t of
T_DollarArithmetic _ t -> checkLeading "$(( (x) )) is the same as $(( x ))" t
T_ForArithmetic _ x y z _ -> mapM_ (checkLeading "for (((x); (y); (z))) is the same as for ((x; y; z))") [x,y,z]
T_Assignment _ _ _ [t] _ -> checkLeading "a[(x)] is the same as a[x]" t
T_Arithmetic _ t -> checkLeading "(( (x) )) is the same as (( x ))" t
TA_Parentesis _ (TA_Sequence _ [ TA_Parentesis id _ ]) ->
styleWithFix id 2322 "In arithmetic contexts, ((x)) is the same as (x). Prefer only one layer of parentheses." $ fix id
_ -> return ()
where
checkLeading str t =
case t of
TA_Sequence _ [TA_Parentesis id _ ] -> styleWithFix id 2323 (str ++ ". Prefer not wrapping in additional parentheses.") $ fix id
_ -> return ()
fix id =
fixWith [
replaceStart id params 1 "", -- Remove "("
replaceEnd id params 1 "" -- Remove ")"
]
return []
runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])