Skip to content

Commit f778216

Browse files
committed
Add dash as a first class supported shell.
1 parent 1eece5b commit f778216

File tree

5 files changed

+59
-34
lines changed

5 files changed

+59
-34
lines changed

ShellCheck/Analytics.hs

+46-20
Original file line numberDiff line numberDiff line change
@@ -74,6 +74,11 @@ checksFor Sh = [
7474
,checkTimeParameters
7575
,checkForDecimals
7676
]
77+
checksFor Dash = [
78+
checkBashisms
79+
,checkForDecimals
80+
,checkLocalScope
81+
]
7782
checksFor Ksh = [
7883
checkEchoSed
7984
]
@@ -587,11 +592,20 @@ prop_checkBashisms28= verify checkBashisms "exec {n}>&2"
587592
prop_checkBashisms29= verify checkBashisms "echo ${!var}"
588593
prop_checkBashisms30= verify checkBashisms "printf -v '%s' \"$1\""
589594
prop_checkBashisms31= verify checkBashisms "printf '%q' \"$1\""
590-
checkBashisms _ = bashism
591-
where
592-
errMsg id s = err id 2040 $ "In sh, " ++ s ++ " not supported, even when sh is actually bash."
593-
warnMsg id s = warn id 2039 $ "In POSIX sh, " ++ s ++ " not supported."
594-
bashism (T_ProcSub id _ _) = errMsg id "process substitution is"
595+
prop_checkBashisms32= verifyNot checkBashisms "#!/bin/dash\n[ foo -nt bar ]"
596+
prop_checkBashisms33= verify checkBashisms "#!/bin/sh\necho -n foo"
597+
prop_checkBashisms34= verifyNot checkBashisms "#!/bin/dash\necho -n foo"
598+
prop_checkBashisms35= verifyNot checkBashisms "#!/bin/dash\nlocal foo"
599+
prop_checkBashisms36= verifyNot checkBashisms "#!/bin/dash\nread -p foo -r bar"
600+
checkBashisms params = bashism
601+
where
602+
isDash = shellType params == Dash
603+
warnMsg id s =
604+
if isDash
605+
then warn id 2169 $ "In dash, " ++ s ++ " not supported."
606+
else warn id 2039 $ "In POSIX sh, " ++ s ++ " undefined."
607+
608+
bashism (T_ProcSub id _ _) = warnMsg id "process substitution is"
595609
bashism (T_Extglob id _ _) = warnMsg id "extglob is"
596610
bashism (T_DollarSingleQuoted id _) = warnMsg id "$'..' is"
597611
bashism (T_DollarDoubleQuoted id _) = warnMsg id "$\"..\" is"
@@ -603,8 +617,10 @@ checkBashisms _ = bashism
603617
bashism (T_Condition id DoubleBracket _) = warnMsg id "[[ ]] is"
604618
bashism (T_HereString id _) = warnMsg id "here-strings are"
605619
bashism (TC_Binary id SingleBracket op _ _)
606-
| op `elem` [ "-nt", "-ef", "\\<", "\\>", "==" ] =
607-
warnMsg id $ op ++ " is"
620+
| op `elem` [ "-nt", "-ef", "\\<", "\\>"] =
621+
unless isDash $ warnMsg id $ op ++ " is"
622+
bashism (TC_Binary id SingleBracket "==" _ _) =
623+
warnMsg id "== in place of = is"
608624
bashism (TC_Unary id _ "-a" _) =
609625
warnMsg id "unary -a in place of -e is"
610626
bashism (TA_Unary id op _)
@@ -646,8 +662,13 @@ checkBashisms _ = bashism
646662

647663
bashism t@(T_SimpleCommand _ _ (cmd:arg:_))
648664
| t `isCommand` "echo" && "-" `isPrefixOf` argString =
649-
unless ("--" `isPrefixOf` argString) $ -- echo "-------"
650-
warnMsg (getId arg) "echo flags are"
665+
unless ("--" `isPrefixOf` argString) $ -- echo "-----"
666+
if isDash
667+
then
668+
when (argString /= "-n") $
669+
warnMsg (getId arg) "echo flags besides -n"
670+
else
671+
warnMsg (getId arg) "echo flags are"
651672
where argString = concat $ oversimplify arg
652673
bashism t@(T_SimpleCommand _ _ (cmd:arg:_))
653674
| t `isCommand` "exec" && "-" `isPrefixOf` concat (oversimplify arg) =
@@ -659,7 +680,8 @@ checkBashisms _ = bashism
659680
let name = fromMaybe "" $ getCommandName t
660681
flags = getLeadingFlags t
661682
in do
662-
when (name `elem` bashCommands) $ warnMsg id $ "'" ++ name ++ "' is"
683+
when (name `elem` unsupportedCommands) $
684+
warnMsg id $ "'" ++ name ++ "' is"
663685
potentially $ do
664686
allowed <- Map.lookup name allowedFlags
665687
(word, flag) <- listToMaybe $ filter (\x -> snd x `notElem` allowed) flags
@@ -681,15 +703,14 @@ checkBashisms _ = bashism
681703
guard $ "%q" `isInfixOf` literal
682704
return $ warnMsg (getId format) "printf %q is"
683705
where
684-
bashCommands = [
706+
unsupportedCommands = [
685707
"let", "caller", "builtin", "complete", "compgen", "declare", "dirs", "disown",
686-
"enable", "mapfile", "readarray", "pushd", "popd", "shopt", "suspend", "type",
687-
"typeset", "local"
688-
]
708+
"enable", "mapfile", "readarray", "pushd", "popd", "shopt", "suspend",
709+
"typeset"
710+
] ++ if not isDash then ["local", "type"] else []
689711
allowedFlags = Map.fromList [
690-
("read", ["r"]),
712+
("read", if isDash then ["r", "p"] else ["r"]),
691713
("ulimit", ["f"]),
692-
("echo", []),
693714
("printf", []),
694715
("exec", [])
695716
]
@@ -1124,9 +1145,8 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do
11241145
isLtGt = flip elem ["<", "\\<", ">", "\\>"]
11251146
isLeGe = flip elem ["<=", "\\<=", ">=", "\\>="]
11261147

1127-
supportsDecimals = (shellType params) == Ksh
11281148
checkDecimals hs =
1129-
when (isFraction hs && not supportsDecimals) $
1149+
when (isFraction hs && not (hasFloatingPoint params)) $
11301150
err (getId hs) 2072 decimalError
11311151
decimalError = "Decimals are not supported. " ++
11321152
"Either use integers only, or use bc or awk to compare."
@@ -1334,7 +1354,8 @@ checkBraceExpansionVars _ (T_BraceExpansion id list) = mapM_ check list
13341354
checkBraceExpansionVars _ _ = return ()
13351355

13361356
prop_checkForDecimals = verify checkForDecimals "((3.14*c))"
1337-
checkForDecimals _ t@(TA_Expansion id _) = potentially $ do
1357+
checkForDecimals params t@(TA_Expansion id _) = potentially $ do
1358+
guard $ not (hasFloatingPoint params)
13381359
str <- getLiteralString t
13391360
first <- str !!! 0
13401361
guard $ isDigit first && '.' `elem` str
@@ -2132,6 +2153,7 @@ leadType shell parents t =
21322153
lastCreatesSubshell =
21332154
case shell of
21342155
Bash -> True
2156+
Dash -> True
21352157
Sh -> True
21362158
Ksh -> False
21372159

@@ -2988,7 +3010,11 @@ checkFunctionDeclarations params
29883010
Ksh ->
29893011
when (hasKeyword && hasParens) $
29903012
err id 2111 "ksh does not allow 'function' keyword and '()' at the same time."
2991-
Sh -> do
3013+
Dash -> forSh
3014+
Sh -> forSh
3015+
3016+
where
3017+
forSh = do
29923018
when (hasKeyword && hasParens) $
29933019
warn id 2112 "'function' keyword is non-standard. Delete it."
29943020
when (hasKeyword && not hasParens) $

ShellCheck/Data.hs

+9-10
Original file line numberDiff line numberDiff line change
@@ -76,13 +76,12 @@ sampleWords = [
7676
]
7777

7878
shellForExecutable :: String -> Maybe Shell
79-
shellForExecutable "sh" = return Sh
80-
shellForExecutable "ash" = return Sh
81-
shellForExecutable "dash" = return Sh
82-
83-
shellForExecutable "ksh" = return Ksh
84-
shellForExecutable "ksh88" = return Ksh
85-
shellForExecutable "ksh93" = return Ksh
86-
87-
shellForExecutable "bash" = return Bash
88-
shellForExecutable _ = Nothing
79+
shellForExecutable name =
80+
case name of
81+
"sh" -> return Sh
82+
"bash" -> return Bash
83+
"dash" -> return Dash
84+
"ksh" -> return Ksh
85+
"ksh88" -> return Ksh
86+
"ksh93" -> return Ksh
87+
otherwise -> Nothing

ShellCheck/Interface.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,7 @@ data AnalysisResult = AnalysisResult {
7373
}
7474

7575
-- Supporting data types
76-
data Shell = Ksh | Sh | Bash deriving (Show, Eq)
76+
data Shell = Ksh | Sh | Bash | Dash deriving (Show, Eq)
7777
data ExecutionMode = Executed | Sourced deriving (Show, Eq)
7878

7979
type ErrorMessage = String

shellcheck.1.md

+1-1
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,7 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts.
4646

4747
**-s**\ *shell*,\ **--shell=***shell*
4848

49-
: Specify Bourne shell dialect. Valid values are *sh*, *bash* and *ksh*.
49+
: Specify Bourne shell dialect. Valid values are *sh*, *bash*, *dash* and *ksh*.
5050
The default is to use the file's shebang, or *bash* if the target shell
5151
can't be determined.
5252

shellcheck.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -74,7 +74,7 @@ options = [
7474
Option "f" ["format"]
7575
(ReqArg (Flag "format") "FORMAT") "output format",
7676
Option "s" ["shell"]
77-
(ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (bash,sh,ksh)",
77+
(ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (sh,bash,dash,ksh)",
7878
Option "x" ["external-sources"]
7979
(NoArg $ Flag "externals" "true") "Allow 'source' outside of FILES.",
8080
Option "V" ["version"]
@@ -219,7 +219,7 @@ parseOption flag options =
219219
liftIO printVersion
220220
throwError NoProblems
221221

222-
Flag "externals" _ -> do
222+
Flag "externals" _ ->
223223
return options {
224224
externalSources = True
225225
}

0 commit comments

Comments
 (0)