diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs index f964dcc..1e40034 100644 --- a/ShellCheck/Analytics.hs +++ b/ShellCheck/Analytics.hs @@ -74,6 +74,11 @@ checksFor Sh = [ ,checkTimeParameters ,checkForDecimals ] +checksFor Dash = [ + checkBashisms + ,checkForDecimals + ,checkLocalScope + ] checksFor Ksh = [ checkEchoSed ] @@ -587,11 +592,20 @@ prop_checkBashisms28= verify checkBashisms "exec {n}>&2" prop_checkBashisms29= verify checkBashisms "echo ${!var}" prop_checkBashisms30= verify checkBashisms "printf -v '%s' \"$1\"" prop_checkBashisms31= verify checkBashisms "printf '%q' \"$1\"" -checkBashisms _ = bashism +prop_checkBashisms32= verifyNot checkBashisms "#!/bin/dash\n[ foo -nt bar ]" +prop_checkBashisms33= verify checkBashisms "#!/bin/sh\necho -n foo" +prop_checkBashisms34= verifyNot checkBashisms "#!/bin/dash\necho -n foo" +prop_checkBashisms35= verifyNot checkBashisms "#!/bin/dash\nlocal foo" +prop_checkBashisms36= verifyNot checkBashisms "#!/bin/dash\nread -p foo -r bar" +checkBashisms params = bashism where - errMsg id s = err id 2040 $ "In sh, " ++ s ++ " not supported, even when sh is actually bash." - warnMsg id s = warn id 2039 $ "In POSIX sh, " ++ s ++ " not supported." - bashism (T_ProcSub id _ _) = errMsg id "process substitution is" + isDash = shellType params == Dash + warnMsg id s = + if isDash + then warn id 2169 $ "In dash, " ++ s ++ " not supported." + else warn id 2039 $ "In POSIX sh, " ++ s ++ " undefined." + + bashism (T_ProcSub id _ _) = warnMsg id "process substitution is" bashism (T_Extglob id _ _) = warnMsg id "extglob is" bashism (T_DollarSingleQuoted id _) = warnMsg id "$'..' is" bashism (T_DollarDoubleQuoted id _) = warnMsg id "$\"..\" is" @@ -603,8 +617,10 @@ checkBashisms _ = bashism bashism (T_Condition id DoubleBracket _) = warnMsg id "[[ ]] is" bashism (T_HereString id _) = warnMsg id "here-strings are" bashism (TC_Binary id SingleBracket op _ _) - | op `elem` [ "-nt", "-ef", "\\<", "\\>", "==" ] = - warnMsg id $ op ++ " is" + | op `elem` [ "-nt", "-ef", "\\<", "\\>"] = + unless isDash $ warnMsg id $ op ++ " is" + bashism (TC_Binary id SingleBracket "==" _ _) = + warnMsg id "== in place of = is" bashism (TC_Unary id _ "-a" _) = warnMsg id "unary -a in place of -e is" bashism (TA_Unary id op _) @@ -646,8 +662,13 @@ checkBashisms _ = bashism bashism t@(T_SimpleCommand _ _ (cmd:arg:_)) | t `isCommand` "echo" && "-" `isPrefixOf` argString = - unless ("--" `isPrefixOf` argString) $ -- echo "-------" - warnMsg (getId arg) "echo flags are" + unless ("--" `isPrefixOf` argString) $ -- echo "-----" + if isDash + then + when (argString /= "-n") $ + warnMsg (getId arg) "echo flags besides -n" + else + warnMsg (getId arg) "echo flags are" where argString = concat $ oversimplify arg bashism t@(T_SimpleCommand _ _ (cmd:arg:_)) | t `isCommand` "exec" && "-" `isPrefixOf` concat (oversimplify arg) = @@ -659,7 +680,8 @@ checkBashisms _ = bashism let name = fromMaybe "" $ getCommandName t flags = getLeadingFlags t in do - when (name `elem` bashCommands) $ warnMsg id $ "'" ++ name ++ "' is" + when (name `elem` unsupportedCommands) $ + warnMsg id $ "'" ++ name ++ "' is" potentially $ do allowed <- Map.lookup name allowedFlags (word, flag) <- listToMaybe $ filter (\x -> snd x `notElem` allowed) flags @@ -681,15 +703,14 @@ checkBashisms _ = bashism guard $ "%q" `isInfixOf` literal return $ warnMsg (getId format) "printf %q is" where - bashCommands = [ + unsupportedCommands = [ "let", "caller", "builtin", "complete", "compgen", "declare", "dirs", "disown", - "enable", "mapfile", "readarray", "pushd", "popd", "shopt", "suspend", "type", - "typeset", "local" - ] + "enable", "mapfile", "readarray", "pushd", "popd", "shopt", "suspend", + "typeset" + ] ++ if not isDash then ["local", "type"] else [] allowedFlags = Map.fromList [ - ("read", ["r"]), + ("read", if isDash then ["r", "p"] else ["r"]), ("ulimit", ["f"]), - ("echo", []), ("printf", []), ("exec", []) ] @@ -1124,9 +1145,8 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do isLtGt = flip elem ["<", "\\<", ">", "\\>"] isLeGe = flip elem ["<=", "\\<=", ">=", "\\>="] - supportsDecimals = (shellType params) == Ksh checkDecimals hs = - when (isFraction hs && not supportsDecimals) $ + when (isFraction hs && not (hasFloatingPoint params)) $ err (getId hs) 2072 decimalError decimalError = "Decimals are not supported. " ++ "Either use integers only, or use bc or awk to compare." @@ -1334,7 +1354,8 @@ checkBraceExpansionVars _ (T_BraceExpansion id list) = mapM_ check list checkBraceExpansionVars _ _ = return () prop_checkForDecimals = verify checkForDecimals "((3.14*c))" -checkForDecimals _ t@(TA_Expansion id _) = potentially $ do +checkForDecimals params t@(TA_Expansion id _) = potentially $ do + guard $ not (hasFloatingPoint params) str <- getLiteralString t first <- str !!! 0 guard $ isDigit first && '.' `elem` str @@ -2132,6 +2153,7 @@ leadType shell parents t = lastCreatesSubshell = case shell of Bash -> True + Dash -> True Sh -> True Ksh -> False @@ -2988,7 +3010,11 @@ checkFunctionDeclarations params Ksh -> when (hasKeyword && hasParens) $ err id 2111 "ksh does not allow 'function' keyword and '()' at the same time." - Sh -> do + Dash -> forSh + Sh -> forSh + + where + forSh = do when (hasKeyword && hasParens) $ warn id 2112 "'function' keyword is non-standard. Delete it." when (hasKeyword && not hasParens) $ diff --git a/ShellCheck/Data.hs b/ShellCheck/Data.hs index bcbf0dc..25cde48 100644 --- a/ShellCheck/Data.hs +++ b/ShellCheck/Data.hs @@ -76,13 +76,12 @@ sampleWords = [ ] shellForExecutable :: String -> Maybe Shell -shellForExecutable "sh" = return Sh -shellForExecutable "ash" = return Sh -shellForExecutable "dash" = return Sh - -shellForExecutable "ksh" = return Ksh -shellForExecutable "ksh88" = return Ksh -shellForExecutable "ksh93" = return Ksh - -shellForExecutable "bash" = return Bash -shellForExecutable _ = Nothing +shellForExecutable name = + case name of + "sh" -> return Sh + "bash" -> return Bash + "dash" -> return Dash + "ksh" -> return Ksh + "ksh88" -> return Ksh + "ksh93" -> return Ksh + otherwise -> Nothing diff --git a/ShellCheck/Interface.hs b/ShellCheck/Interface.hs index 97c4d7a..5b5e346 100644 --- a/ShellCheck/Interface.hs +++ b/ShellCheck/Interface.hs @@ -73,7 +73,7 @@ data AnalysisResult = AnalysisResult { } -- Supporting data types -data Shell = Ksh | Sh | Bash deriving (Show, Eq) +data Shell = Ksh | Sh | Bash | Dash deriving (Show, Eq) data ExecutionMode = Executed | Sourced deriving (Show, Eq) type ErrorMessage = String diff --git a/shellcheck.1.md b/shellcheck.1.md index 4d29c0e..ae0c05d 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -46,7 +46,7 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts. **-s**\ *shell*,\ **--shell=***shell* -: Specify Bourne shell dialect. Valid values are *sh*, *bash* and *ksh*. +: Specify Bourne shell dialect. Valid values are *sh*, *bash*, *dash* and *ksh*. The default is to use the file's shebang, or *bash* if the target shell can't be determined. diff --git a/shellcheck.hs b/shellcheck.hs index 3f8888e..25a8134 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -74,7 +74,7 @@ options = [ Option "f" ["format"] (ReqArg (Flag "format") "FORMAT") "output format", Option "s" ["shell"] - (ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (bash,sh,ksh)", + (ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (sh,bash,dash,ksh)", Option "x" ["external-sources"] (NoArg $ Flag "externals" "true") "Allow 'source' outside of FILES.", Option "V" ["version"] @@ -219,7 +219,7 @@ parseOption flag options = liftIO printVersion throwError NoProblems - Flag "externals" _ -> do + Flag "externals" _ -> return options { externalSources = True }