Improve warnings for bad parameter expansion (fixes #2297)
This commit is contained in:
parent
fed4a048bc
commit
bb0a571a1e
|
@ -6,6 +6,7 @@
|
||||||
- SC2292: Suggest [[ over [ in Bash/Ksh scripts (optional)
|
- SC2292: Suggest [[ over [ in Bash/Ksh scripts (optional)
|
||||||
- SC2293/SC2294: Warn when calling `eval` with arrays
|
- SC2293/SC2294: Warn when calling `eval` with arrays
|
||||||
- SC2295: Warn about "${x#$y}" treating $y as a pattern when not quoted
|
- SC2295: Warn about "${x#$y}" treating $y as a pattern when not quoted
|
||||||
|
- SC2296-SC2301: Improved warnings for bad parameter expansions
|
||||||
|
|
||||||
### Fixed
|
### Fixed
|
||||||
- SC2102 about repetitions in ranges no longer triggers on [[ -v arr[xx] ]]
|
- SC2102 about repetitions in ranges no longer triggers on [[ -v arr[xx] ]]
|
||||||
|
|
|
@ -136,7 +136,7 @@ nodeChecks = [
|
||||||
,checkValidCondOps
|
,checkValidCondOps
|
||||||
,checkGlobbedRegex
|
,checkGlobbedRegex
|
||||||
,checkTestRedirects
|
,checkTestRedirects
|
||||||
,checkIndirectExpansion
|
,checkBadParameterSubstitution
|
||||||
,checkPS1Assignments
|
,checkPS1Assignments
|
||||||
,checkBackticks
|
,checkBackticks
|
||||||
,checkInexplicablyUnquoted
|
,checkInexplicablyUnquoted
|
||||||
|
@ -1608,29 +1608,79 @@ checkBackticks params (T_Backticked id list) | not (null list) =
|
||||||
(fixWith [replaceStart id params 1 "$(", replaceEnd id params 1 ")"])
|
(fixWith [replaceStart id params 1 "$(", replaceEnd id params 1 ")"])
|
||||||
checkBackticks _ _ = return ()
|
checkBackticks _ _ = return ()
|
||||||
|
|
||||||
prop_checkIndirectExpansion1 = verify checkIndirectExpansion "${foo$n}"
|
|
||||||
prop_checkIndirectExpansion2 = verifyNot checkIndirectExpansion "${foo//$n/lol}"
|
prop_checkBadParameterSubstitution1 = verify checkBadParameterSubstitution "${foo$n}"
|
||||||
prop_checkIndirectExpansion3 = verify checkIndirectExpansion "${$#}"
|
prop_checkBadParameterSubstitution2 = verifyNot checkBadParameterSubstitution "${foo//$n/lol}"
|
||||||
prop_checkIndirectExpansion4 = verify checkIndirectExpansion "${var${n}_$((i%2))}"
|
prop_checkBadParameterSubstitution3 = verify checkBadParameterSubstitution "${$#}"
|
||||||
prop_checkIndirectExpansion5 = verifyNot checkIndirectExpansion "${bar}"
|
prop_checkBadParameterSubstitution4 = verify checkBadParameterSubstitution "${var${n}_$((i%2))}"
|
||||||
checkIndirectExpansion _ (T_DollarBraced i _ (T_NormalWord _ contents))
|
prop_checkBadParameterSubstitution5 = verifyNot checkBadParameterSubstitution "${bar}"
|
||||||
| isIndirection contents =
|
prop_checkBadParameterSubstitution6 = verify checkBadParameterSubstitution "${\"bar\"}"
|
||||||
err i 2082 "To expand via indirection, use arrays, ${!name} or (for sh only) eval."
|
prop_checkBadParameterSubstitution7 = verify checkBadParameterSubstitution "${{var}"
|
||||||
|
prop_checkBadParameterSubstitution8 = verify checkBadParameterSubstitution "${$(x)//x/y}"
|
||||||
|
prop_checkBadParameterSubstitution9 = verifyNot checkBadParameterSubstitution "$# ${#} $! ${!} ${!#} ${#!}"
|
||||||
|
prop_checkBadParameterSubstitution10 = verify checkBadParameterSubstitution "${'foo'}"
|
||||||
|
prop_checkBadParameterSubstitution11 = verify checkBadParameterSubstitution "${${x%.*}##*/}"
|
||||||
|
|
||||||
|
checkBadParameterSubstitution _ t =
|
||||||
|
case t of
|
||||||
|
(T_DollarBraced i _ (T_NormalWord _ contents@(first:_))) ->
|
||||||
|
if isIndirection contents
|
||||||
|
then err i 2082 "To expand via indirection, use arrays, ${!name} or (for sh only) eval."
|
||||||
|
else checkFirst first
|
||||||
|
_ -> return ()
|
||||||
|
|
||||||
where
|
where
|
||||||
|
|
||||||
isIndirection vars =
|
isIndirection vars =
|
||||||
let list = mapMaybe isIndirectionPart vars in
|
let list = mapMaybe isIndirectionPart vars in
|
||||||
not (null list) && and list
|
not (null list) && and list
|
||||||
|
|
||||||
isIndirectionPart t =
|
isIndirectionPart t =
|
||||||
case t of T_DollarExpansion _ _ -> Just True
|
case t of T_DollarExpansion {} -> Just True
|
||||||
T_Backticked _ _ -> Just True
|
T_Backticked {} -> Just True
|
||||||
T_DollarBraced _ _ _ -> Just True
|
T_DollarBraced {} -> Just True
|
||||||
T_DollarArithmetic _ _ -> Just True
|
T_DollarArithmetic {} -> Just True
|
||||||
T_Literal _ s -> if all isVariableChar s
|
T_Literal _ s -> if all isVariableChar s
|
||||||
then Nothing
|
then Nothing
|
||||||
else Just False
|
else Just False
|
||||||
_ -> Just False
|
_ -> Just False
|
||||||
|
|
||||||
checkIndirectExpansion _ _ = return ()
|
checkFirst t =
|
||||||
|
case t of
|
||||||
|
T_Literal id (c:_) ->
|
||||||
|
if isVariableChar c || isSpecialVariableChar c
|
||||||
|
then return ()
|
||||||
|
else err id 2296 $ "Parameter expansions can't start with " ++ e4m [c] ++ ". Double check syntax."
|
||||||
|
|
||||||
|
T_ParamSubSpecialChar {} -> return ()
|
||||||
|
|
||||||
|
T_DoubleQuoted id [T_Literal _ s] | isVariable s ->
|
||||||
|
err id 2297 "Double quotes must be outside ${}: ${\"invalid\"} vs \"${valid}\"."
|
||||||
|
|
||||||
|
T_DollarBraced id braces _ | isUnmodifiedParameterExpansion t ->
|
||||||
|
err id 2298 $
|
||||||
|
(if braces then "${${x}}" else "${$x}")
|
||||||
|
++ " is invalid. For expansion, use ${x}. For indirection, use arrays, ${!x} or (for sh) eval."
|
||||||
|
|
||||||
|
T_DollarBraced {} ->
|
||||||
|
err (getId t) 2299 "Parameter expansions can't be nested. Use temporary variables."
|
||||||
|
|
||||||
|
_ | isCommandSubstitution t ->
|
||||||
|
err (getId t) 2300 "Parameter expansion can't be applied to command substitutions. Use temporary variables."
|
||||||
|
|
||||||
|
_ -> err (getId t) 2301 $ "Parameter expansion starts with unexpected " ++ name t ++ ". Double check syntax."
|
||||||
|
|
||||||
|
isVariable str =
|
||||||
|
case str of
|
||||||
|
[c] -> isVariableStartChar c || isSpecialVariableChar c || isDigit c
|
||||||
|
x -> isVariableName x
|
||||||
|
|
||||||
|
name t =
|
||||||
|
case t of
|
||||||
|
T_SingleQuoted {} -> "quotes"
|
||||||
|
T_DoubleQuoted {} -> "quotes"
|
||||||
|
_ -> "syntax"
|
||||||
|
|
||||||
|
|
||||||
prop_checkInexplicablyUnquoted1 = verify checkInexplicablyUnquoted "echo 'var='value';'"
|
prop_checkInexplicablyUnquoted1 = verify checkInexplicablyUnquoted "echo 'var='value';'"
|
||||||
prop_checkInexplicablyUnquoted2 = verifyNot checkInexplicablyUnquoted "'foo'*"
|
prop_checkInexplicablyUnquoted2 = verifyNot checkInexplicablyUnquoted "'foo'*"
|
||||||
|
@ -4434,5 +4484,6 @@ checkUnquotedParameterExpansionPattern params x =
|
||||||
surroundWith (getId t) params "\""
|
surroundWith (getId t) params "\""
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
return []
|
return []
|
||||||
runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])
|
runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])
|
||||||
|
|
|
@ -816,6 +816,7 @@ isConfusedGlobRegex _ = False
|
||||||
|
|
||||||
isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x
|
isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x
|
||||||
isVariableChar x = isVariableStartChar x || isDigit x
|
isVariableChar x = isVariableStartChar x || isDigit x
|
||||||
|
isSpecialVariableChar = (`elem` "*@#?-$!")
|
||||||
variableNameRegex = mkRegex "[_a-zA-Z][_a-zA-Z0-9]*"
|
variableNameRegex = mkRegex "[_a-zA-Z][_a-zA-Z0-9]*"
|
||||||
|
|
||||||
prop_isVariableName1 = isVariableName "_fo123"
|
prop_isVariableName1 = isVariableName "_fo123"
|
||||||
|
@ -861,7 +862,7 @@ getBracedReference s = fromMaybe s $
|
||||||
let name = takeWhile isVariableChar s
|
let name = takeWhile isVariableChar s
|
||||||
guard . not $ null name
|
guard . not $ null name
|
||||||
return name
|
return name
|
||||||
getSpecial (c:_) | c `elem` "*@#?-$!" = return [c]
|
getSpecial (c:_) | isSpecialVariableChar c = return [c]
|
||||||
getSpecial _ = fail "empty or not special"
|
getSpecial _ = fail "empty or not special"
|
||||||
|
|
||||||
nameExpansion ('!':next:rest) = do -- e.g. ${!foo*bar*}
|
nameExpansion ('!':next:rest) = do -- e.g. ${!foo*bar*}
|
||||||
|
@ -955,5 +956,17 @@ isBashLike params =
|
||||||
Dash -> False
|
Dash -> False
|
||||||
Sh -> False
|
Sh -> False
|
||||||
|
|
||||||
|
-- Returns whether a token is a parameter expansion without any modifiers.
|
||||||
|
-- True for $var ${var} $1 $#
|
||||||
|
-- False for ${#var} ${var[x]} ${var:-0}
|
||||||
|
isUnmodifiedParameterExpansion t =
|
||||||
|
case t of
|
||||||
|
T_DollarBraced _ False _ -> True
|
||||||
|
T_DollarBraced _ _ list ->
|
||||||
|
let str = concat $ oversimplify list
|
||||||
|
in getBracedReference str == str
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
|
||||||
return []
|
return []
|
||||||
runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])
|
runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])
|
||||||
|
|
Loading…
Reference in New Issue