From bf9297e2a5bc8c568d96126853235dae3998b0d9 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Thu, 3 Sep 2015 20:26:02 -0700 Subject: [PATCH] Parse ksh ${ ..; } expansions. --- ShellCheck/AST.hs | 3 +++ ShellCheck/Analytics.hs | 4 ++++ ShellCheck/Parser.hs | 30 ++++++++++++++++++++++++++---- 3 files changed, 33 insertions(+), 4 deletions(-) diff --git a/ShellCheck/AST.hs b/ShellCheck/AST.hs index be2043e..376cd83 100644 --- a/ShellCheck/AST.hs +++ b/ShellCheck/AST.hs @@ -72,6 +72,7 @@ data Token = | T_DollarDoubleQuoted Id [Token] | T_DollarExpansion Id [Token] | T_DollarSingleQuoted Id String + | T_DollarBraceCommandExpansion Id [Token] | T_Done Id | T_DoubleQuoted Id [Token] | T_EOF Id @@ -174,6 +175,7 @@ analyze f g i = delve (T_DoubleQuoted id list) = dl list $ T_DoubleQuoted id delve (T_DollarDoubleQuoted id list) = dl list $ T_DollarDoubleQuoted id delve (T_DollarExpansion id list) = dl list $ T_DollarExpansion id + delve (T_DollarBraceCommandExpansion id list) = dl list $ T_DollarBraceCommandExpansion id delve (T_BraceExpansion id list) = dl list $ T_BraceExpansion id delve (T_Backticked id list) = dl list $ T_Backticked id delve (T_DollarArithmetic id c) = d1 c $ T_DollarArithmetic id @@ -302,6 +304,7 @@ getId t = case t of T_DollarBraced id _ -> id T_DollarArithmetic id _ -> id T_BraceExpansion id _ -> id + T_DollarBraceCommandExpansion id _ -> id T_IoFile id _ _ -> id T_HereDoc id _ _ _ _ -> id T_HereString id _ -> id diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs index 501cd97..26aef13 100644 --- a/ShellCheck/Analytics.hs +++ b/ShellCheck/Analytics.hs @@ -807,6 +807,7 @@ checkUnquotedExpansions params = where check t@(T_DollarExpansion _ _) = examine t check t@(T_Backticked _ _) = examine t + check t@(T_DollarBraceCommandExpansion _ _) = examine t check _ = return () tree = parentMap params examine t = @@ -2035,6 +2036,7 @@ prop_subshellAssignmentCheck13 = verifyTree subshellAssignmentCheck "#!/bin/bash prop_subshellAssignmentCheck14 = verifyNotTree subshellAssignmentCheck "#!/bin/ksh93\necho foo | read bar; echo $bar" 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_subshellAssignmentCheck17 = verifyNotTree subshellAssignmentCheck "foo=${ { bar=$(baz); } 2>&1; }; echo $foo $bar" subshellAssignmentCheck params t = let flow = variableFlow params check = findSubshelled flow [("oops",[])] Map.empty @@ -3155,6 +3157,7 @@ checkTildeInPath _ _ = return () 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_checkUnsupported5 = verify checkUnsupported "#!/bin/bash\necho \"${ ls; }\"" checkUnsupported params t = when (not (null support) && (shellType params `notElem` support)) $ report name @@ -3168,6 +3171,7 @@ checkUnsupported params t = shellSupport t = case t of T_CaseExpression _ _ list -> forCase (map (\(a,_,_) -> a) list) + T_DollarBraceCommandExpansion {} -> ("${ ..; } command expansion", [Ksh]) otherwise -> ("", []) where forCase seps | CaseContinue `elem` seps = ("cases with ;;&", [Bash]) diff --git a/ShellCheck/Parser.hs b/ShellCheck/Parser.hs index a612537..da83722 100644 --- a/ShellCheck/Parser.hs +++ b/ShellCheck/Parser.hs @@ -967,6 +967,8 @@ prop_readDoubleQuoted2 = isOk readDoubleQuoted "\"$'\"" prop_readDoubleQuoted3 = isWarning readDoubleQuoted "\x201Chello\x201D" prop_readDoubleQuoted4 = isWarning readSimpleCommand "\"foo\nbar\"foo" prop_readDoubleQuoted5 = isOk readSimpleCommand "lol \"foo\nbar\" etc" +prop_readDoubleQuoted6 = isOk readSimpleCommand "echo \"${ ls; }\"" +prop_readDoubleQuoted7 = isOk readSimpleCommand "echo \"${ ls;}bar\"" readDoubleQuoted = called "double quoted string" $ do id <- getNextId startPos <- getPosition @@ -1172,7 +1174,7 @@ readBraced = try braceExpansion readNormalDollar = readDollarExpression <|> readDollarDoubleQuote <|> readDollarSingleQuote <|> readDollarLonely readDoubleQuotedDollar = readDollarExpression <|> readDollarLonely -readDollarExpression = readDollarArithmetic <|> readDollarBracket <|> readDollarBraced <|> readDollarExpansion <|> readDollarVariable +readDollarExpression = readDollarArithmetic <|> readDollarBracket <|> readDollarBraceCommandExpansion <|> readDollarBraced <|> readDollarExpansion <|> readDollarVariable prop_readDollarSingleQuote = isOk readDollarSingleQuote "$'foo\\\'lol'" readDollarSingleQuote = called "$'..' expression" $ do @@ -1216,6 +1218,18 @@ readArithmeticExpression = called "((..)) command" $ do string "))" return (T_Arithmetic id c) +prop_readDollarBraceCommandExpansion1 = isOk readDollarBraceCommandExpansion "${ ls; }" +prop_readDollarBraceCommandExpansion2 = isOk readDollarBraceCommandExpansion "${\nls\n}" +readDollarBraceCommandExpansion = called "ksh ${ ..; } command expansion" $ do + id <- getNextId + try $ do + string "${" + whitespace + allspacing + term <- readTerm + char '}' <|> fail "Expected } to end the ksh ${ ..; } command expansion" + return $ T_DollarBraceCommandExpansion id term + prop_readDollarBraced1 = isOk readDollarBraced "${foo//bar/baz}" prop_readDollarBraced2 = isOk readDollarBraced "${foo/'{cow}'}" prop_readDollarBraced3 = isOk readDollarBraced "${foo%%$(echo cow\\})}" @@ -2133,9 +2147,14 @@ tryWordToken s t = tryParseWordToken s t `thenSkip` spacing tryParseWordToken keyword t = try $ do id <- getNextId str <- anycaseString keyword - optional (do + + optional $ do try . lookAhead $ char '[' - parseProblem ErrorC 1069 "You need a space before the [.") + parseProblem ErrorC 1069 "You need a space before the [." + optional $ do + try . lookAhead $ char '#' + parseProblem ErrorC 1099 "You need a space before the #." + try $ lookAhead keywordSeparator when (str /= keyword) $ parseProblem ErrorC 1081 $ @@ -2174,7 +2193,10 @@ g_For = tryWordToken "for" T_For g_Select = tryWordToken "select" T_Select g_In = tryWordToken "in" T_In g_Lbrace = tryWordToken "{" T_Lbrace -g_Rbrace = tryWordToken "}" T_Rbrace +g_Rbrace = do -- handled specially due to ksh echo "${ foo; }bar" + id <- getNextId + char '}' + return $ T_Rbrace id g_Lparen = tryToken "(" T_Lparen g_Rparen = tryToken ")" T_Rparen