make busybox sh Dash-like
This commit is contained in:
parent
be8e4b2b8a
commit
1e1045e73e
|
@ -1204,6 +1204,7 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do
|
||||||
case shellType params of
|
case shellType params of
|
||||||
Sh -> return () -- These are unsupported and will be caught by bashism checks.
|
Sh -> return () -- These are unsupported and will be caught by bashism checks.
|
||||||
Dash -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting."
|
Dash -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting."
|
||||||
|
BusyboxSh -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting."
|
||||||
_ -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting (or switch to [[ .. ]])."
|
_ -> err id 2073 $ "Escape \\" ++ op ++ " to prevent it redirecting (or switch to [[ .. ]])."
|
||||||
|
|
||||||
when (op `elem` arithmeticBinaryTestOps) $ do
|
when (op `elem` arithmeticBinaryTestOps) $ do
|
||||||
|
@ -2782,6 +2783,7 @@ checkFunctionDeclarations params
|
||||||
when (hasKeyword && hasParens) $
|
when (hasKeyword && hasParens) $
|
||||||
err id 2111 "ksh does not allow 'function' keyword and '()' at the same time."
|
err id 2111 "ksh does not allow 'function' keyword and '()' at the same time."
|
||||||
Dash -> forSh
|
Dash -> forSh
|
||||||
|
BusyboxSh -> forSh
|
||||||
Sh -> forSh
|
Sh -> forSh
|
||||||
|
|
||||||
where
|
where
|
||||||
|
@ -4044,7 +4046,8 @@ prop_checkModifiedArithmeticInRedirection3 = verifyNot checkModifiedArithmeticIn
|
||||||
prop_checkModifiedArithmeticInRedirection4 = verify checkModifiedArithmeticInRedirection "cat <<< $((i++))"
|
prop_checkModifiedArithmeticInRedirection4 = verify checkModifiedArithmeticInRedirection "cat <<< $((i++))"
|
||||||
prop_checkModifiedArithmeticInRedirection5 = verify checkModifiedArithmeticInRedirection "cat << foo\n$((i++))\nfoo\n"
|
prop_checkModifiedArithmeticInRedirection5 = verify checkModifiedArithmeticInRedirection "cat << foo\n$((i++))\nfoo\n"
|
||||||
prop_checkModifiedArithmeticInRedirection6 = verifyNot checkModifiedArithmeticInRedirection "#!/bin/dash\nls > $((i=i+1))"
|
prop_checkModifiedArithmeticInRedirection6 = verifyNot checkModifiedArithmeticInRedirection "#!/bin/dash\nls > $((i=i+1))"
|
||||||
checkModifiedArithmeticInRedirection params t = unless (shellType params == Dash) $
|
prop_checkModifiedArithmeticInRedirection7 = verifyNot checkModifiedArithmeticInRedirection "#!/bin/busybox sh\ncat << foo\n$((i++))\nfoo\n"
|
||||||
|
checkModifiedArithmeticInRedirection params t = unless (shellType params == Dash || shellType params == BusyboxSh) $
|
||||||
case t of
|
case t of
|
||||||
T_Redirecting _ redirs (T_SimpleCommand _ _ (_:_)) -> mapM_ checkRedirs redirs
|
T_Redirecting _ redirs (T_SimpleCommand _ _ (_:_)) -> mapM_ checkRedirs redirs
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
|
@ -4356,6 +4359,7 @@ checkEqualsInCommand params originalToken =
|
||||||
Bash -> errWithFix id 2277 "Use BASH_ARGV0 to assign to $0 in bash (or use [ ] to compare)." bashfix
|
Bash -> errWithFix id 2277 "Use BASH_ARGV0 to assign to $0 in bash (or use [ ] to compare)." bashfix
|
||||||
Ksh -> err id 2278 "$0 can't be assigned in Ksh (but it does reflect the current function)."
|
Ksh -> err id 2278 "$0 can't be assigned in Ksh (but it does reflect the current function)."
|
||||||
Dash -> err id 2279 "$0 can't be assigned in Dash. This becomes a command name."
|
Dash -> err id 2279 "$0 can't be assigned in Dash. This becomes a command name."
|
||||||
|
BusyboxSh -> err id 2279 "$0 can't be assigned in Busybox Ash. This becomes a command name."
|
||||||
_ -> err id 2280 "$0 can't be assigned this way, and there is no portable alternative."
|
_ -> err id 2280 "$0 can't be assigned this way, and there is no portable alternative."
|
||||||
leadingNumberMsg id =
|
leadingNumberMsg id =
|
||||||
err id 2282 "Variable names can't start with numbers, so this is interpreted as a command."
|
err id 2282 "Variable names can't start with numbers, so this is interpreted as a command."
|
||||||
|
|
|
@ -206,18 +206,21 @@ makeParameters spec = params
|
||||||
case shellType params of
|
case shellType params of
|
||||||
Bash -> isOptionSet "lastpipe" root
|
Bash -> isOptionSet "lastpipe" root
|
||||||
Dash -> False
|
Dash -> False
|
||||||
|
BusyboxSh -> False
|
||||||
Sh -> False
|
Sh -> False
|
||||||
Ksh -> True,
|
Ksh -> True,
|
||||||
hasInheritErrexit =
|
hasInheritErrexit =
|
||||||
case shellType params of
|
case shellType params of
|
||||||
Bash -> isOptionSet "inherit_errexit" root
|
Bash -> isOptionSet "inherit_errexit" root
|
||||||
Dash -> True
|
Dash -> True
|
||||||
|
BusyboxSh -> True
|
||||||
Sh -> True
|
Sh -> True
|
||||||
Ksh -> False,
|
Ksh -> False,
|
||||||
hasPipefail =
|
hasPipefail =
|
||||||
case shellType params of
|
case shellType params of
|
||||||
Bash -> isOptionSet "pipefail" root
|
Bash -> isOptionSet "pipefail" root
|
||||||
Dash -> True
|
Dash -> True
|
||||||
|
BusyboxSh -> isOptionSet "pipefail" root
|
||||||
Sh -> True
|
Sh -> True
|
||||||
Ksh -> isOptionSet "pipefail" root,
|
Ksh -> isOptionSet "pipefail" root,
|
||||||
shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec),
|
shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec),
|
||||||
|
@ -899,6 +902,7 @@ isBashLike params =
|
||||||
Bash -> True
|
Bash -> True
|
||||||
Ksh -> True
|
Ksh -> True
|
||||||
Dash -> False
|
Dash -> False
|
||||||
|
BusyboxSh -> False
|
||||||
Sh -> False
|
Sh -> False
|
||||||
|
|
||||||
isTrueAssignmentSource c =
|
isTrueAssignmentSource c =
|
||||||
|
|
|
@ -930,7 +930,7 @@ prop_checkTimedCommand2 = verify checkTimedCommand "#!/bin/dash\ntime ( foo; bar
|
||||||
prop_checkTimedCommand3 = verifyNot checkTimedCommand "#!/bin/sh\ntime sleep 1"
|
prop_checkTimedCommand3 = verifyNot checkTimedCommand "#!/bin/sh\ntime sleep 1"
|
||||||
checkTimedCommand = CommandCheck (Exactly "time") f where
|
checkTimedCommand = CommandCheck (Exactly "time") f where
|
||||||
f (T_SimpleCommand _ _ (c:args@(_:_))) =
|
f (T_SimpleCommand _ _ (c:args@(_:_))) =
|
||||||
whenShell [Sh, Dash] $ do
|
whenShell [Sh, Dash, BusyboxSh] $ do
|
||||||
let cmd = last args -- "time" is parsed with a command as argument
|
let cmd = last args -- "time" is parsed with a command as argument
|
||||||
when (isPiped cmd) $
|
when (isPiped cmd) $
|
||||||
warn (getId c) 2176 "'time' is undefined for pipelines. time single stage or bash -c instead."
|
warn (getId c) 2176 "'time' is undefined for pipelines. time single stage or bash -c instead."
|
||||||
|
@ -954,7 +954,7 @@ checkTimedCommand = CommandCheck (Exactly "time") f where
|
||||||
prop_checkLocalScope1 = verify checkLocalScope "local foo=3"
|
prop_checkLocalScope1 = verify checkLocalScope "local foo=3"
|
||||||
prop_checkLocalScope2 = verifyNot checkLocalScope "f() { local foo=3; }"
|
prop_checkLocalScope2 = verifyNot checkLocalScope "f() { local foo=3; }"
|
||||||
checkLocalScope = CommandCheck (Exactly "local") $ \t ->
|
checkLocalScope = CommandCheck (Exactly "local") $ \t ->
|
||||||
whenShell [Bash, Dash] $ do -- Ksh allows it, Sh doesn't support local
|
whenShell [Bash, Dash, BusyboxSh] $ do -- Ksh allows it, Sh doesn't support local
|
||||||
path <- getPathM t
|
path <- getPathM t
|
||||||
unless (any isFunctionLike path) $
|
unless (any isFunctionLike path) $
|
||||||
err (getId $ getCommandTokenOrThis t) 2168 "'local' is only valid in functions."
|
err (getId $ getCommandTokenOrThis t) 2168 "'local' is only valid in functions."
|
||||||
|
|
|
@ -76,7 +76,7 @@ verifyNot c s = producesComments (testChecker c) s == Just False
|
||||||
prop_checkForDecimals1 = verify checkForDecimals "((3.14*c))"
|
prop_checkForDecimals1 = verify checkForDecimals "((3.14*c))"
|
||||||
prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar"
|
prop_checkForDecimals2 = verify checkForDecimals "foo[1.2]=bar"
|
||||||
prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=bar"
|
prop_checkForDecimals3 = verifyNot checkForDecimals "declare -A foo; foo[1.2]=bar"
|
||||||
checkForDecimals = ForShell [Sh, Dash, Bash] f
|
checkForDecimals = ForShell [Sh, Dash, BusyboxSh, Bash] f
|
||||||
where
|
where
|
||||||
f t@(TA_Expansion id _) = sequence_ $ do
|
f t@(TA_Expansion id _) = sequence_ $ do
|
||||||
str <- getLiteralString t
|
str <- getLiteralString t
|
||||||
|
@ -196,14 +196,16 @@ prop_checkBashisms101 = verify checkBashisms "read"
|
||||||
prop_checkBashisms102 = verifyNot checkBashisms "read -r foo"
|
prop_checkBashisms102 = verifyNot checkBashisms "read -r foo"
|
||||||
prop_checkBashisms103 = verifyNot checkBashisms "read foo"
|
prop_checkBashisms103 = verifyNot checkBashisms "read foo"
|
||||||
prop_checkBashisms104 = verifyNot checkBashisms "read ''"
|
prop_checkBashisms104 = verifyNot checkBashisms "read ''"
|
||||||
checkBashisms = ForShell [Sh, Dash] $ \t -> do
|
prop_checkBashisms105 = verifyNot checkBashisms "#!/bin/busybox sh\nset -o pipefail"
|
||||||
|
checkBashisms = ForShell [Sh, Dash, BusyboxSh] $ \t -> do
|
||||||
params <- ask
|
params <- ask
|
||||||
kludge params t
|
kludge params t
|
||||||
where
|
where
|
||||||
-- This code was copy-pasted from Analytics where params was a variable
|
-- This code was copy-pasted from Analytics where params was a variable
|
||||||
kludge params = bashism
|
kludge params = bashism
|
||||||
where
|
where
|
||||||
isDash = shellType params == Dash
|
isBusyboxSh = shellType params == BusyboxSh
|
||||||
|
isDash = shellType params == Dash || isBusyboxSh
|
||||||
warnMsg id code s =
|
warnMsg id code s =
|
||||||
if isDash
|
if isDash
|
||||||
then err id code $ "In dash, " ++ s ++ " not supported."
|
then err id code $ "In dash, " ++ s ++ " not supported."
|
||||||
|
@ -590,7 +592,7 @@ checkPS1Assignments = ForShell [Bash] f
|
||||||
|
|
||||||
prop_checkMultipleBangs1 = verify checkMultipleBangs "! ! true"
|
prop_checkMultipleBangs1 = verify checkMultipleBangs "! ! true"
|
||||||
prop_checkMultipleBangs2 = verifyNot checkMultipleBangs "! true"
|
prop_checkMultipleBangs2 = verifyNot checkMultipleBangs "! true"
|
||||||
checkMultipleBangs = ForShell [Dash, Sh] f
|
checkMultipleBangs = ForShell [Dash, BusyboxSh, Sh] f
|
||||||
where
|
where
|
||||||
f token = case token of
|
f token = case token of
|
||||||
T_Banged id (T_Banged _ _) ->
|
T_Banged id (T_Banged _ _) ->
|
||||||
|
@ -601,7 +603,7 @@ checkMultipleBangs = ForShell [Dash, Sh] f
|
||||||
prop_checkBangAfterPipe1 = verify checkBangAfterPipe "true | ! true"
|
prop_checkBangAfterPipe1 = verify checkBangAfterPipe "true | ! true"
|
||||||
prop_checkBangAfterPipe2 = verifyNot checkBangAfterPipe "true | ( ! true )"
|
prop_checkBangAfterPipe2 = verifyNot checkBangAfterPipe "true | ( ! true )"
|
||||||
prop_checkBangAfterPipe3 = verifyNot checkBangAfterPipe "! ! true | true"
|
prop_checkBangAfterPipe3 = verifyNot checkBangAfterPipe "! ! true | true"
|
||||||
checkBangAfterPipe = ForShell [Dash, Sh, Bash] f
|
checkBangAfterPipe = ForShell [Dash, BusyboxSh, Sh, Bash] f
|
||||||
where
|
where
|
||||||
f token = case token of
|
f token = case token of
|
||||||
T_Pipeline _ _ cmds -> mapM_ check cmds
|
T_Pipeline _ _ cmds -> mapM_ check cmds
|
||||||
|
|
Loading…
Reference in New Issue