Killed Zsh support

This commit is contained in:
Vidar Holen 2015-03-20 10:03:56 -07:00
parent 80cf5d9852
commit ed56a837c3
6 changed files with 65 additions and 79 deletions

View File

@ -28,7 +28,6 @@ data Dashed = Dashed | Undashed deriving (Show, Eq)
data AssignmentMode = Assign | Append deriving (Show, Eq) data AssignmentMode = Assign | Append deriving (Show, Eq)
data FunctionKeyword = FunctionKeyword Bool deriving (Show, Eq) data FunctionKeyword = FunctionKeyword Bool deriving (Show, Eq)
data FunctionParentheses = FunctionParentheses Bool deriving (Show, Eq) data FunctionParentheses = FunctionParentheses Bool deriving (Show, Eq)
data ForInType = NormalForIn | ShortForIn deriving (Show, Eq)
data CaseType = CaseBreak | CaseFallThrough | CaseContinue deriving (Show, Eq) data CaseType = CaseBreak | CaseFallThrough | CaseContinue deriving (Show, Eq)
data Token = data Token =
@ -49,7 +48,6 @@ data Token =
| T_Arithmetic Id Token | T_Arithmetic Id Token
| T_Array Id [Token] | T_Array Id [Token]
| T_IndexedElement Id Token Token | T_IndexedElement Id Token Token
| T_ Id [Token]
| T_Assignment Id AssignmentMode String (Maybe Token) Token | T_Assignment Id AssignmentMode String (Maybe Token) Token
| T_Backgrounded Id Token | T_Backgrounded Id Token
| T_Backticked Id [Token] | T_Backticked Id [Token]
@ -83,7 +81,7 @@ data Token =
| T_Fi Id | T_Fi Id
| T_For Id | T_For Id
| T_ForArithmetic Id Token Token Token [Token] | T_ForArithmetic Id Token Token Token [Token]
| T_ForIn Id ForInType [String] [Token] [Token] | T_ForIn Id String [Token] [Token]
| T_Function Id FunctionKeyword FunctionParentheses String Token | T_Function Id FunctionKeyword FunctionParentheses String Token
| T_GREATAND Id | T_GREATAND Id
| T_Glob Id String | T_Glob Id String
@ -207,7 +205,7 @@ analyze f g i =
delve (T_BraceGroup id l) = dl l $ T_BraceGroup id delve (T_BraceGroup id l) = dl l $ T_BraceGroup id
delve (T_WhileExpression id c l) = dll c l $ T_WhileExpression id delve (T_WhileExpression id c l) = dll c l $ T_WhileExpression id
delve (T_UntilExpression id c l) = dll c l $ T_UntilExpression id delve (T_UntilExpression id c l) = dll c l $ T_UntilExpression id
delve (T_ForIn id t v w l) = dll w l $ T_ForIn id t v delve (T_ForIn id v w l) = dll w l $ T_ForIn id v
delve (T_SelectIn id v w l) = dll w l $ T_SelectIn id v delve (T_SelectIn id v w l) = dll w l $ T_SelectIn id v
delve (T_CaseExpression id word cases) = do delve (T_CaseExpression id word cases) = do
newWord <- round word newWord <- round word
@ -316,7 +314,7 @@ getId t = case t of
T_BraceGroup id _ -> id T_BraceGroup id _ -> id
T_WhileExpression id _ _ -> id T_WhileExpression id _ _ -> id
T_UntilExpression id _ _ -> id T_UntilExpression id _ _ -> id
T_ForIn id _ _ _ _ -> id T_ForIn id _ _ _ -> id
T_SelectIn id _ _ _ -> id T_SelectIn id _ _ _ -> id
T_CaseExpression id _ _ -> id T_CaseExpression id _ _ -> id
T_Function id _ _ _ _ -> id T_Function id _ _ _ _ -> id

View File

@ -71,10 +71,6 @@ checksFor Sh = [
checksFor Ksh = [ checksFor Ksh = [
checkEchoSed checkEchoSed
] ]
checksFor Zsh = [
checkTimeParameters
,checkEchoSed
]
checksFor Bash = [ checksFor Bash = [
checkTimeParameters checkTimeParameters
,checkBraceExpansionVars ,checkBraceExpansionVars
@ -116,7 +112,6 @@ shellForExecutable "ksh" = return Ksh
shellForExecutable "ksh88" = return Ksh shellForExecutable "ksh88" = return Ksh
shellForExecutable "ksh93" = return Ksh shellForExecutable "ksh93" = return Ksh
shellForExecutable "zsh" = return Zsh
shellForExecutable "bash" = return Bash shellForExecutable "bash" = return Bash
shellForExecutable _ = Nothing shellForExecutable _ = Nothing
@ -723,17 +718,17 @@ prop_checkForInQuoted4 = verify checkForInQuoted "for f in 1,2,3; do true; done"
prop_checkForInQuoted4a = verifyNot checkForInQuoted "for f in foo{1,2,3}; do true; done" prop_checkForInQuoted4a = verifyNot checkForInQuoted "for f in foo{1,2,3}; do true; done"
prop_checkForInQuoted5 = verify checkForInQuoted "for f in ls; do true; done" prop_checkForInQuoted5 = verify checkForInQuoted "for f in ls; do true; done"
prop_checkForInQuoted6 = verifyNot checkForInQuoted "for f in \"${!arr}\"; do true; done" prop_checkForInQuoted6 = verifyNot checkForInQuoted "for f in \"${!arr}\"; do true; done"
checkForInQuoted _ (T_ForIn _ _ f [T_NormalWord _ [word@(T_DoubleQuoted id list)]] _) = checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [word@(T_DoubleQuoted id list)]] _) =
when (any (\x -> willSplit x && not (mayBecomeMultipleArgs x)) list when (any (\x -> willSplit x && not (mayBecomeMultipleArgs x)) list
|| (liftM wouldHaveBeenGlob (getLiteralString word) == Just True)) $ || (liftM wouldHaveBeenGlob (getLiteralString word) == Just True)) $
err id 2066 "Since you double quoted this, it will not word split, and the loop will only run once." err id 2066 "Since you double quoted this, it will not word split, and the loop will only run once."
checkForInQuoted _ (T_ForIn _ _ f [T_NormalWord _ [T_SingleQuoted id s]] _) = checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [T_SingleQuoted id s]] _) =
warn id 2041 $ "This is a literal string. To run as a command, use $(" ++ s ++ ")." warn id 2041 $ "This is a literal string. To run as a command, use $(" ++ s ++ ")."
checkForInQuoted _ (T_ForIn _ _ f [T_NormalWord _ [T_Literal id s]] _) = checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [T_Literal id s]] _) =
if ',' `elem` s if ',' `elem` s
then unless ('{' `elem` s) $ then unless ('{' `elem` s) $
warn id 2042 "Use spaces, not commas, to separate loop elements." warn id 2042 "Use spaces, not commas, to separate loop elements."
else warn id 2043 $ "This loop will only run once, with " ++ head f ++ "='" ++ s ++ "'." else warn id 2043 $ "This loop will only run once, with " ++ f ++ "='" ++ s ++ "'."
checkForInQuoted _ _ = return () checkForInQuoted _ _ = return ()
prop_checkForInCat1 = verify checkForInCat "for f in $(cat foo); do stuff; done" prop_checkForInCat1 = verify checkForInCat "for f in $(cat foo); do stuff; done"
@ -741,7 +736,7 @@ prop_checkForInCat1a= verify checkForInCat "for f in `cat foo`; do stuff; done"
prop_checkForInCat2 = verify checkForInCat "for f in $(cat foo | grep lol); do stuff; done" prop_checkForInCat2 = verify checkForInCat "for f in $(cat foo | grep lol); do stuff; done"
prop_checkForInCat2a= verify checkForInCat "for f in `cat foo | grep lol`; do stuff; done" prop_checkForInCat2a= verify checkForInCat "for f in `cat foo | grep lol`; do stuff; done"
prop_checkForInCat3 = verifyNot checkForInCat "for f in $(cat foo | grep bar | wc -l); do stuff; done" prop_checkForInCat3 = verifyNot checkForInCat "for f in $(cat foo | grep bar | wc -l); do stuff; done"
checkForInCat _ (T_ForIn _ _ f [T_NormalWord _ w] _) = mapM_ checkF w checkForInCat _ (T_ForIn _ f [T_NormalWord _ w] _) = mapM_ checkF w
where where
checkF (T_DollarExpansion id [T_Pipeline _ _ r]) checkF (T_DollarExpansion id [T_Pipeline _ _ r])
| all isLineBased r = | all isLineBased r =
@ -757,9 +752,9 @@ prop_checkForInLs2 = verify checkForInLs "for f in `ls *.mp3`; do mplayer \"$f\"
prop_checkForInLs3 = verify checkForInLs "for f in `find / -name '*.mp3'`; do mplayer \"$f\"; done" prop_checkForInLs3 = verify checkForInLs "for f in `find / -name '*.mp3'`; do mplayer \"$f\"; done"
checkForInLs _ = try checkForInLs _ = try
where where
try (T_ForIn _ _ f [T_NormalWord _ [T_DollarExpansion id [x]]] _) = try (T_ForIn _ f [T_NormalWord _ [T_DollarExpansion id [x]]] _) =
check id f x check id f x
try (T_ForIn _ _ f [T_NormalWord _ [T_Backticked id [x]]] _) = try (T_ForIn _ f [T_NormalWord _ [T_Backticked id [x]]] _) =
check id f x check id f x
try _ = return () try _ = return ()
check id f x = check id f x =
@ -1068,7 +1063,6 @@ prop_checkNumberComparisons6 = verify checkNumberComparisons "[[ 3.14 -eq $foo ]
prop_checkNumberComparisons7 = verifyNot checkNumberComparisons "[[ 3.14 == $foo ]]" prop_checkNumberComparisons7 = verifyNot checkNumberComparisons "[[ 3.14 == $foo ]]"
prop_checkNumberComparisons8 = verify checkNumberComparisons "[[ foo <= bar ]]" prop_checkNumberComparisons8 = verify checkNumberComparisons "[[ foo <= bar ]]"
prop_checkNumberComparisons9 = verify checkNumberComparisons "[ foo \\>= bar ]" prop_checkNumberComparisons9 = verify checkNumberComparisons "[ foo \\>= bar ]"
prop_checkNumberComparisons10= verify checkNumberComparisons "#!/bin/zsh -x\n[ foo >= bar ]]"
prop_checkNumberComparisons11= verify checkNumberComparisons "[[ $foo -eq 'N' ]]" prop_checkNumberComparisons11= verify checkNumberComparisons "[[ $foo -eq 'N' ]]"
prop_checkNumberComparisons12= verify checkNumberComparisons "[ x$foo -gt x${N} ]" prop_checkNumberComparisons12= verify checkNumberComparisons "[ x$foo -gt x${N} ]"
checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do
@ -1097,9 +1091,7 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do
isLtGt = flip elem ["<", "\\<", ">", "\\>"] isLtGt = flip elem ["<", "\\<", ">", "\\>"]
isLeGe = flip elem ["<=", "\\<=", ">=", "\\>="] isLeGe = flip elem ["<=", "\\<=", ">=", "\\>="]
supportsDecimals = supportsDecimals = (shellType params) == Ksh
let sh = shellType params in
sh == Ksh || sh == Zsh
checkDecimals hs = checkDecimals hs =
when (isFraction hs && not supportsDecimals) $ when (isFraction hs && not supportsDecimals) $
err (getId hs) 2072 decimalError err (getId hs) 2072 decimalError
@ -1882,7 +1874,7 @@ checkSpuriousExec _ = doLists
doLists (T_BraceGroup _ cmds) = doList cmds doLists (T_BraceGroup _ cmds) = doList cmds
doLists (T_WhileExpression _ _ cmds) = doList cmds doLists (T_WhileExpression _ _ cmds) = doList cmds
doLists (T_UntilExpression _ _ cmds) = doList cmds doLists (T_UntilExpression _ _ cmds) = doList cmds
doLists (T_ForIn _ _ _ _ cmds) = doList cmds doLists (T_ForIn _ _ _ cmds) = doList cmds
doLists (T_ForArithmetic _ _ _ _ cmds) = doList cmds doLists (T_ForArithmetic _ _ _ _ cmds) = doList cmds
doLists (T_IfExpression _ thens elses) = do doLists (T_IfExpression _ thens elses) = do
mapM_ (\(_, l) -> doList l) thens mapM_ (\(_, l) -> doList l) thens
@ -2010,7 +2002,7 @@ prop_subshellAssignmentCheck11 = verifyTree subshellAssignmentCheck "cat /etc/pa
prop_subshellAssignmentCheck12 = verifyTree subshellAssignmentCheck "cat /etc/passwd | while read line; do let ++n; done\necho $n" prop_subshellAssignmentCheck12 = verifyTree subshellAssignmentCheck "cat /etc/passwd | while read line; do let ++n; done\necho $n"
prop_subshellAssignmentCheck13 = verifyTree subshellAssignmentCheck "#!/bin/bash\necho foo | read bar; echo $bar" prop_subshellAssignmentCheck13 = verifyTree subshellAssignmentCheck "#!/bin/bash\necho foo | read bar; echo $bar"
prop_subshellAssignmentCheck14 = verifyNotTree subshellAssignmentCheck "#!/bin/ksh93\necho foo | read bar; echo $bar" prop_subshellAssignmentCheck14 = verifyNotTree subshellAssignmentCheck "#!/bin/ksh93\necho foo | read bar; echo $bar"
prop_subshellAssignmentCheck15 = verifyNotTree subshellAssignmentCheck "#!/bin/zsh\ncat foo | while read bar; do a=$bar; done\necho \"$a\"" prop_subshellAssignmentCheck15 = verifyNotTree subshellAssignmentCheck "#!/bin/ksh\ncat foo | while read bar; do a=$bar; done\necho \"$a\""
prop_subshellAssignmentCheck16 = verifyNotTree subshellAssignmentCheck "(set -e); echo $@" prop_subshellAssignmentCheck16 = verifyNotTree subshellAssignmentCheck "(set -e); echo $@"
subshellAssignmentCheck params t = subshellAssignmentCheck params t =
let flow = variableFlow params let flow = variableFlow params
@ -2069,7 +2061,6 @@ leadType shell parents t =
Bash -> True Bash -> True
Sh -> True Sh -> True
Ksh -> False Ksh -> False
Zsh -> False
getModifiedVariables t = getModifiedVariables t =
case t of case t of
@ -2097,7 +2088,7 @@ getModifiedVariables t =
[(t, t, fromMaybe "COPROC" name, DataArray SourceExternal)] [(t, t, fromMaybe "COPROC" name, DataArray SourceExternal)]
--Points to 'for' rather than variable --Points to 'for' rather than variable
T_ForIn id _ strs words _ -> map (\str -> (t, t, str, DataString $ SourceFrom words)) strs T_ForIn id str words _ -> [(t, t, str, DataString $ SourceFrom words)]
T_SelectIn id str words _ -> [(t, t, str, DataString $ SourceFrom words)] T_SelectIn id str words _ -> [(t, t, str, DataString $ SourceFrom words)]
_ -> [] _ -> []
@ -2782,7 +2773,7 @@ prop_checkCdAndBack3 = verifyNot checkCdAndBack "while [[ $PWD != / ]]; do cd ..
checkCdAndBack params = doLists checkCdAndBack params = doLists
where where
shell = shellType params shell = shellType params
doLists (T_ForIn _ _ _ _ cmds) = doList cmds doLists (T_ForIn _ _ _ cmds) = doList cmds
doLists (T_ForArithmetic _ _ _ _ cmds) = doList cmds doLists (T_ForArithmetic _ _ _ _ cmds) = doList cmds
doLists (T_WhileExpression _ _ cmds) = doList cmds doLists (T_WhileExpression _ _ cmds) = doList cmds
doLists (T_UntilExpression _ _ cmds) = doList cmds doLists (T_UntilExpression _ _ cmds) = doList cmds
@ -2806,7 +2797,7 @@ checkCdAndBack params = doLists
warn (getId $ head cds) 2103 message warn (getId $ head cds) 2103 message
message = message =
if shell == Bash || shell == Zsh if shell == Bash
then "Consider using ( subshell ), 'cd foo||exit', or pushd/popd instead." then "Consider using ( subshell ), 'cd foo||exit', or pushd/popd instead."
else "Consider using ( subshell ) or 'cd foo||exit' instead." else "Consider using ( subshell ) or 'cd foo||exit' instead."
@ -2846,7 +2837,6 @@ checkFunctionDeclarations params
(T_Function id (FunctionKeyword hasKeyword) (FunctionParentheses hasParens) _ _) = (T_Function id (FunctionKeyword hasKeyword) (FunctionParentheses hasParens) _ _) =
case shellType params of case shellType params of
Bash -> return () Bash -> return ()
Zsh -> return ()
Ksh -> Ksh ->
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."
@ -2939,7 +2929,7 @@ checkInteractiveSu params = checkCommand "su" f
prop_checkStderrPipe1 = verify checkStderrPipe "#!/bin/ksh\nfoo |& bar" prop_checkStderrPipe1 = verify checkStderrPipe "#!/bin/ksh\nfoo |& bar"
prop_checkStderrPipe2 = verifyNot checkStderrPipe "#!/bin/zsh\nfoo |& bar" prop_checkStderrPipe2 = verifyNot checkStderrPipe "#!/bin/bash\nfoo |& bar"
checkStderrPipe params = checkStderrPipe params =
case shellType params of case shellType params of
Ksh -> match Ksh -> match
@ -3076,8 +3066,6 @@ checkTildeInPath _ (T_SimpleCommand _ vars _) =
isQuoted _ = False isQuoted _ = False
checkTildeInPath _ _ = return () checkTildeInPath _ _ = return ()
prop_checkUnsupported1 = verifyNot checkUnsupported "#!/bin/zsh\nfunction { echo cow; }"
prop_checkUnsupported2 = verify checkUnsupported "#!/bin/sh\nfunction { echo cow; }"
prop_checkUnsupported3 = verify checkUnsupported "#!/bin/sh\ncase foo in bar) baz ;& esac" prop_checkUnsupported3 = verify checkUnsupported "#!/bin/sh\ncase foo in bar) baz ;& esac"
prop_checkUnsupported4 = verify checkUnsupported "#!/bin/ksh\ncase foo in bar) baz ;;& esac" prop_checkUnsupported4 = verify checkUnsupported "#!/bin/ksh\ncase foo in bar) baz ;;& esac"
checkUnsupported params t = checkUnsupported params t =
@ -3092,15 +3080,11 @@ checkUnsupported params t =
-- TODO: Move more of these checks here -- TODO: Move more of these checks here
shellSupport t = shellSupport t =
case t of case t of
T_Function _ _ _ "" _ -> ("anonymous functions", [Zsh])
T_ForIn _ _ (_:_:_) _ _ -> ("multi-index for loops", [Zsh])
T_ForIn _ ShortForIn _ _ _ -> ("short form for loops", [Zsh])
T_ProcSub _ "=" _ -> ("=(..) process substitution", [Zsh])
T_CaseExpression _ _ list -> forCase (map (\(a,_,_) -> a) list) T_CaseExpression _ _ list -> forCase (map (\(a,_,_) -> a) list)
otherwise -> ("", []) otherwise -> ("", [])
where where
forCase seps | CaseContinue `elem` seps = ("cases with ;;&", [Bash]) forCase seps | CaseContinue `elem` seps = ("cases with ;;&", [Bash])
forCase seps | CaseFallThrough `elem` seps = ("cases with ;&", [Bash, Ksh, Zsh]) forCase seps | CaseFallThrough `elem` seps = ("cases with ;&", [Bash, Ksh])
forCase _ = ("", []) forCase _ = ("", [])
@ -3109,7 +3093,7 @@ getCommandSequences (T_BraceGroup _ cmds) = [cmds]
getCommandSequences (T_Subshell _ cmds) = [cmds] getCommandSequences (T_Subshell _ cmds) = [cmds]
getCommandSequences (T_WhileExpression _ _ cmds) = [cmds] getCommandSequences (T_WhileExpression _ _ cmds) = [cmds]
getCommandSequences (T_UntilExpression _ _ cmds) = [cmds] getCommandSequences (T_UntilExpression _ _ cmds) = [cmds]
getCommandSequences (T_ForIn _ _ _ _ cmds) = [cmds] getCommandSequences (T_ForIn _ _ _ cmds) = [cmds]
getCommandSequences (T_ForArithmetic _ _ _ _ cmds) = [cmds] getCommandSequences (T_ForArithmetic _ _ _ _ cmds) = [cmds]
getCommandSequences (T_IfExpression _ thens elses) = map snd thens ++ [elses] getCommandSequences (T_IfExpression _ thens elses) = map snd thens ++ [elses]
getCommandSequences _ = [] getCommandSequences _ = []

View File

@ -1,6 +1,6 @@
module ShellCheck.Options where module ShellCheck.Options where
data Shell = Ksh | Zsh | Sh | Bash data Shell = Ksh | Sh | Bash
deriving (Show, Eq) deriving (Show, Eq)
data AnalysisOptions = AnalysisOptions { data AnalysisOptions = AnalysisOptions {

View File

@ -765,11 +765,10 @@ readDollarBracedLiteral = do
prop_readProcSub1 = isOk readProcSub "<(echo test | wc -l)" prop_readProcSub1 = isOk readProcSub "<(echo test | wc -l)"
prop_readProcSub2 = isOk readProcSub "<( if true; then true; fi )" prop_readProcSub2 = isOk readProcSub "<( if true; then true; fi )"
prop_readProcSub3 = isOk readProcSub "=(ls)"
readProcSub = called "process substitution" $ do readProcSub = called "process substitution" $ do
id <- getNextId id <- getNextId
dir <- try $ do dir <- try $ do
x <- oneOf "<>=" x <- oneOf "<>"
char '(' char '('
return [x] return [x]
allspacing allspacing
@ -1358,7 +1357,6 @@ prop_readSimpleCommand3 = isOk readSimpleCommand "export foo=(bar baz)"
prop_readSimpleCommand4 = isOk readSimpleCommand "typeset -a foo=(lol)" prop_readSimpleCommand4 = isOk readSimpleCommand "typeset -a foo=(lol)"
prop_readSimpleCommand5 = isOk readSimpleCommand "time if true; then echo foo; fi" prop_readSimpleCommand5 = isOk readSimpleCommand "time if true; then echo foo; fi"
prop_readSimpleCommand6 = isOk readSimpleCommand "time -p ( ls -l; )" prop_readSimpleCommand6 = isOk readSimpleCommand "time -p ( ls -l; )"
prop_readSimpleCommand7 = isOk readSimpleCommand "cat =(ls)"
readSimpleCommand = called "simple command" $ do readSimpleCommand = called "simple command" $ do
id1 <- getNextId id1 <- getNextId
id2 <- getNextId id2 <- getNextId
@ -1634,7 +1632,6 @@ prop_readForClause7 = isOk readForClause "for ((;;)) do echo $i\ndone"
prop_readForClause8 = isOk readForClause "for ((;;)) ; do echo $i\ndone" prop_readForClause8 = isOk readForClause "for ((;;)) ; do echo $i\ndone"
prop_readForClause9 = isOk readForClause "for i do true; done" prop_readForClause9 = isOk readForClause "for i do true; done"
prop_readForClause10= isOk readForClause "for ((;;)) { true; }" prop_readForClause10= isOk readForClause "for ((;;)) { true; }"
prop_readForClause11= isOk readForClause "for a b in *; do echo $a $b; done"
prop_readForClause12= isWarning readForClause "for $a in *; do echo \"$a\"; done" prop_readForClause12= isWarning readForClause "for $a in *; do echo \"$a\"; done"
readForClause = called "for loop" $ do readForClause = called "for loop" $ do
pos <- getPosition pos <- getPosition
@ -1663,25 +1660,10 @@ readForClause = called "for loop" $ do
readRegular id pos = do readRegular id pos = do
acceptButWarn (char '$') ErrorC 1086 acceptButWarn (char '$') ErrorC 1086
"Don't use $ on the iterator name in for loops." "Don't use $ on the iterator name in for loops."
names <- readNames name <- readVariableName `thenSkip` spacing
readShort names <|> readLong names values <- readInClause <|> (optional readSequentialSep >> return [])
where group <- readDoGroup pos
readLong names = do return $ T_ForIn id name values group
values <- readInClause <|> (optional readSequentialSep >> return [])
group <- readDoGroup pos
return $ T_ForIn id NormalForIn names values group
readShort names = do
char '('
allspacing
words <- many (readNormalWord `thenSkip` allspacing)
char ')'
allspacing
command <- readAndOr
return $ T_ForIn id ShortForIn names words [command]
readNames =
reluctantlyTill1 (readVariableName `thenSkip` spacing) $
disregard g_Do <|> disregard readInClause <|> disregard readSequentialSep
prop_readSelectClause1 = isOk readSelectClause "select foo in *; do echo $foo; done" prop_readSelectClause1 = isOk readSelectClause "select foo in *; do echo $foo; done"
prop_readSelectClause2 = isOk readSelectClause "select foo; do echo $foo; done" prop_readSelectClause2 = isOk readSelectClause "select foo; do echo $foo; done"
@ -1802,7 +1784,7 @@ readFunctionDefinition = called "function" $ do
g_Rparen g_Rparen
return () return ()
readFunctionName = many functionChars readFunctionName = many1 functionChars
prop_readCoProc1 = isOk readCoProc "coproc foo { echo bar; }" prop_readCoProc1 = isOk readCoProc "coproc foo { echo bar; }"
prop_readCoProc2 = isOk readCoProc "coproc { echo bar; }" prop_readCoProc2 = isOk readCoProc "coproc { echo bar; }"
@ -1892,9 +1874,6 @@ readAssignmentWord = try $ do
pos <- getPosition pos <- getPosition
optional (char '$' >> parseNote ErrorC 1066 "Don't use $ on the left side of assignments.") optional (char '$' >> parseNote ErrorC 1066 "Don't use $ on the left side of assignments.")
variable <- readVariableName variable <- readVariableName
notFollowedBy2 $ do -- Special case for zsh =(..) syntax
spacing1
string "=("
optional (readNormalDollar >> parseNoteAt pos ErrorC optional (readNormalDollar >> parseNoteAt pos ErrorC
1067 "For indirection, use (associative) arrays or 'read \"var$n\" <<< \"value\"'") 1067 "For indirection, use (associative) arrays or 'read \"var$n\" <<< \"value\"'")
index <- optionMaybe readArrayIndex index <- optionMaybe readArrayIndex
@ -2093,8 +2072,8 @@ readScript = do
verifyShell pos s = verifyShell pos s =
case isValidShell s of case isValidShell s of
Just True -> return () Just True -> return ()
Just False -> parseProblemAt pos ErrorC 1071 "ShellCheck only supports Bourne based shell scripts, sorry!" Just False -> parseProblemAt pos ErrorC 1071 "ShellCheck only supports sh/bash/ksh scripts. Sorry!"
Nothing -> parseProblemAt pos InfoC 1008 "This shebang was unrecognized. Note that ShellCheck only handles Bourne based shells." Nothing -> parseProblemAt pos InfoC 1008 "This shebang was unrecognized. Note that ShellCheck only handles sh/bash/ksh."
isValidShell s = isValidShell s =
let good = s == "" || any (`isPrefixOf` s) goodShells let good = s == "" || any (`isPrefixOf` s) goodShells
@ -2108,9 +2087,10 @@ readScript = do
goodShells = [ goodShells = [
"sh", "sh",
"ash",
"dash",
"bash", "bash",
"ksh", "ksh"
"zsh"
] ]
badShells = [ badShells = [
"awk", "awk",
@ -2118,7 +2098,8 @@ readScript = do
"perl", "perl",
"python", "python",
"ruby", "ruby",
"tcsh" "tcsh",
"zsh"
] ]
readUtf8Bom = called "Byte Order Mark" $ string "\xFEFF" readUtf8Bom = called "Byte Order Mark" $ string "\xFEFF"

View File

@ -16,6 +16,20 @@ errors and pitfalls where the shell just gives a cryptic error message or
strange behavior, but it also reports on a few more advanced issues where strange behavior, but it also reports on a few more advanced issues where
corner cases can cause delayed failures. corner cases can cause delayed failures.
ShellCheck gives shell specific advice. Consider the line:
(( area = 3.14*r*r ))
+ For scripts starting with `#!/bin/sh` (or when using `-s sh`), ShellCheck
will warn that `(( .. ))` is not POSIX compliant (similar to checkbashisms).
+ For scripts starting with `#!/bin/bash` (or using `-s bash`), ShellCheck
will warn that decimals are not supported.
+ For scripts starting with `#!/bin/ksh` (or using `-s ksh`), ShellCheck will
not warn at all, as `ksh` supports decimals in arithmetic contexts.
# OPTIONS # OPTIONS
**-e**\ *CODE1*[,*CODE2*...],\ **--exclude=***CODE1*[,*CODE2*...] **-e**\ *CODE1*[,*CODE2*...],\ **--exclude=***CODE1*[,*CODE2*...]
@ -32,9 +46,9 @@ corner cases can cause delayed failures.
**-s**\ *shell*,\ **--shell=***shell* **-s**\ *shell*,\ **--shell=***shell*
: Specify Bourne shell dialect. Valid values are *sh*, *bash*, *ksh* and : Specify Bourne shell dialect. Valid values are *sh*, *bash* and *ksh*.
*zsh*. The default is to use the file's shebang, or *bash* if the target The default is to use the file's shebang, or *bash* if the target shell
shell can't be determined. can't be determined.
**-V**\ *version*,\ **--version** **-V**\ *version*,\ **--version**
@ -83,11 +97,12 @@ corner cases can cause delayed failures.
[ [
{ {
"line": line, "file": "filename",
"column": column, "line": lineNumber,
"level": level, "column": columnNumber,
"code": ####, "level": "severitylevel",
"message": message "code": errorCode,
"message": "warning message"
}, },
... ...
] ]
@ -104,6 +119,14 @@ For example, to suppress SC2035 about using `./*.jpg`:
# shellcheck disable=SC2035 # shellcheck disable=SC2035
echo "Files: " *.jpg echo "Files: " *.jpg
Here a shell brace group is used to suppress on multiple lines:
# shellcheck disable=SC2016
{
echo 'Modifying $PATH'
echo 'PATH=foo:$PATH' >> ~/.bashrc
}
Valid keys are: Valid keys are:
**disable** **disable**

View File

@ -57,7 +57,7 @@ options = [
Option "f" ["format"] Option "f" ["format"]
(ReqArg (Flag "format") "FORMAT") "output format", (ReqArg (Flag "format") "FORMAT") "output format",
Option "s" ["shell"] Option "s" ["shell"]
(ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (bash,sh,ksh,zsh)", (ReqArg (Flag "shell") "SHELLNAME") "Specify dialect (bash,sh,ksh)",
Option "V" ["version"] Option "V" ["version"]
(NoArg $ Flag "version" "true") "Print version information" (NoArg $ Flag "version" "true") "Print version information"
] ]