make busybox sh Dash-like

This commit is contained in:
Grische 2023-11-25 12:52:32 +01:00
parent be8e4b2b8a
commit 1e1045e73e
4 changed files with 18 additions and 8 deletions

View File

@ -1204,6 +1204,7 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do
case shellType params of
Sh -> return () -- These are unsupported and will be caught by bashism checks.
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 [[ .. ]])."
when (op `elem` arithmeticBinaryTestOps) $ do
@ -2782,6 +2783,7 @@ checkFunctionDeclarations params
when (hasKeyword && hasParens) $
err id 2111 "ksh does not allow 'function' keyword and '()' at the same time."
Dash -> forSh
BusyboxSh -> forSh
Sh -> forSh
where
@ -4044,7 +4046,8 @@ prop_checkModifiedArithmeticInRedirection3 = verifyNot checkModifiedArithmeticIn
prop_checkModifiedArithmeticInRedirection4 = verify checkModifiedArithmeticInRedirection "cat <<< $((i++))"
prop_checkModifiedArithmeticInRedirection5 = verify checkModifiedArithmeticInRedirection "cat << foo\n$((i++))\nfoo\n"
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
T_Redirecting _ redirs (T_SimpleCommand _ _ (_:_)) -> mapM_ checkRedirs redirs
_ -> 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
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."
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."
leadingNumberMsg id =
err id 2282 "Variable names can't start with numbers, so this is interpreted as a command."

View File

@ -206,18 +206,21 @@ makeParameters spec = params
case shellType params of
Bash -> isOptionSet "lastpipe" root
Dash -> False
BusyboxSh -> False
Sh -> False
Ksh -> True,
hasInheritErrexit =
case shellType params of
Bash -> isOptionSet "inherit_errexit" root
Dash -> True
BusyboxSh -> True
Sh -> True
Ksh -> False,
hasPipefail =
case shellType params of
Bash -> isOptionSet "pipefail" root
Dash -> True
BusyboxSh -> isOptionSet "pipefail" root
Sh -> True
Ksh -> isOptionSet "pipefail" root,
shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec),
@ -899,6 +902,7 @@ isBashLike params =
Bash -> True
Ksh -> True
Dash -> False
BusyboxSh -> False
Sh -> False
isTrueAssignmentSource c =

View File

@ -930,7 +930,7 @@ prop_checkTimedCommand2 = verify checkTimedCommand "#!/bin/dash\ntime ( foo; bar
prop_checkTimedCommand3 = verifyNot checkTimedCommand "#!/bin/sh\ntime sleep 1"
checkTimedCommand = CommandCheck (Exactly "time") f where
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
when (isPiped cmd) $
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_checkLocalScope2 = verifyNot checkLocalScope "f() { local foo=3; }"
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
unless (any isFunctionLike path) $
err (getId $ getCommandTokenOrThis t) 2168 "'local' is only valid in functions."

View File

@ -76,7 +76,7 @@ verifyNot c s = producesComments (testChecker c) s == Just False
prop_checkForDecimals1 = verify checkForDecimals "((3.14*c))"
prop_checkForDecimals2 = verify checkForDecimals "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
f t@(TA_Expansion id _) = sequence_ $ do
str <- getLiteralString t
@ -196,14 +196,16 @@ prop_checkBashisms101 = verify checkBashisms "read"
prop_checkBashisms102 = verifyNot checkBashisms "read -r foo"
prop_checkBashisms103 = verifyNot checkBashisms "read foo"
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
kludge params t
where
-- This code was copy-pasted from Analytics where params was a variable
kludge params = bashism
where
isDash = shellType params == Dash
isBusyboxSh = shellType params == BusyboxSh
isDash = shellType params == Dash || isBusyboxSh
warnMsg id code s =
if isDash
then err id code $ "In dash, " ++ s ++ " not supported."
@ -590,7 +592,7 @@ checkPS1Assignments = ForShell [Bash] f
prop_checkMultipleBangs1 = verify checkMultipleBangs "! ! true"
prop_checkMultipleBangs2 = verifyNot checkMultipleBangs "! true"
checkMultipleBangs = ForShell [Dash, Sh] f
checkMultipleBangs = ForShell [Dash, BusyboxSh, Sh] f
where
f token = case token of
T_Banged id (T_Banged _ _) ->
@ -601,7 +603,7 @@ checkMultipleBangs = ForShell [Dash, Sh] f
prop_checkBangAfterPipe1 = verify checkBangAfterPipe "true | ! true"
prop_checkBangAfterPipe2 = verifyNot checkBangAfterPipe "true | ( ! true )"
prop_checkBangAfterPipe3 = verifyNot checkBangAfterPipe "! ! true | true"
checkBangAfterPipe = ForShell [Dash, Sh, Bash] f
checkBangAfterPipe = ForShell [Dash, BusyboxSh, Sh, Bash] f
where
f token = case token of
T_Pipeline _ _ cmds -> mapM_ check cmds