From d16bf41c3d0785732394e5d9ff0830525cf5ea79 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sun, 25 Feb 2018 17:58:29 -0800 Subject: [PATCH] Better support arrays in arithmetic contexts. Fixes #1074 --- ShellCheck/AST.hs | 6 +++--- ShellCheck/Analytics.hs | 6 +++--- ShellCheck/AnalyzerLib.hs | 18 +++++++---------- ShellCheck/Checks/ShellSupport.hs | 8 +++----- ShellCheck/Parser.hs | 32 +++++++++++++++++-------------- 5 files changed, 34 insertions(+), 36 deletions(-) diff --git a/ShellCheck/AST.hs b/ShellCheck/AST.hs index 466dbe2..2f99c3b 100644 --- a/ShellCheck/AST.hs +++ b/ShellCheck/AST.hs @@ -37,8 +37,8 @@ newtype Root = Root Token data Token = TA_Binary Id String Token Token | TA_Assignment Id String Token Token + | TA_Variable Id String [Token] | TA_Expansion Id [Token] - | TA_Index Id Token | TA_Sequence Id [Token] | TA_Trinary Id Token Token Token | TA_Unary Id String Token @@ -266,7 +266,7 @@ analyze f g i = c <- round t3 return $ TA_Trinary id a b c delve (TA_Expansion id t) = dl t $ TA_Expansion id - delve (TA_Index id t) = d1 t $ TA_Index id + delve (TA_Variable id str t) = dl t $ TA_Variable id str delve (T_Annotation id anns t) = d1 t $ T_Annotation id anns delve (T_CoProc id var body) = d1 body $ T_CoProc id var delve (T_CoProcBody id t) = d1 t $ T_CoProcBody id @@ -360,7 +360,6 @@ getId t = case t of TA_Sequence id _ -> id TA_Trinary id _ _ _ -> id TA_Expansion id _ -> id - TA_Index id _ -> id T_ProcSub id _ _ -> id T_Glob id _ -> id T_ForArithmetic id _ _ _ _ -> id @@ -374,6 +373,7 @@ getId t = case t of T_Include id _ _ -> id T_UnparsedIndex id _ _ -> id TC_Empty id _ -> id + TA_Variable id _ _ -> id blank :: Monad m => Token -> m () blank = const $ return () diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs index ea9d16e..2e3f826 100644 --- a/ShellCheck/Analytics.hs +++ b/ShellCheck/Analytics.hs @@ -1141,12 +1141,10 @@ checkArithmeticDeref params t@(TA_Expansion _ [b@(T_DollarBraced id _)]) = T_Arithmetic {} -> return normalWarning T_DollarArithmetic {} -> return normalWarning T_ForArithmetic {} -> return normalWarning - TA_Index {} -> return indexWarning T_SimpleCommand {} -> return noWarning _ -> Nothing normalWarning = style id 2004 "$/${} is unnecessary on arithmetic variables." - indexWarning = style id 2149 "Remove $/${} for numeric index, or escape it for string." noWarning = return () checkArithmeticDeref _ _ = return () @@ -1825,6 +1823,7 @@ prop_checkUnused34= verifyNotTree checkUnusedAssignments "foo=1; (( t = foo )); prop_checkUnused35= verifyNotTree checkUnusedAssignments "a=foo; b=2; echo ${a:b}" prop_checkUnused36= verifyNotTree checkUnusedAssignments "if [[ -v foo ]]; then true; fi" prop_checkUnused37= verifyNotTree checkUnusedAssignments "fd=2; exec {fd}>&-" +prop_checkUnused38= verifyTree checkUnusedAssignments "(( a=42 ))" checkUnusedAssignments params t = execWriter (mapM_ warnFor unused) where flow = variableFlow params @@ -1880,6 +1879,7 @@ prop_checkUnassignedReferences30= verifyNotTree checkUnassignedReferences "if [[ prop_checkUnassignedReferences31= verifyNotTree checkUnassignedReferences "X=1; if [[ -v foo[$X+42] ]]; then echo ${foo[$X+42]}; fi" prop_checkUnassignedReferences32= verifyNotTree checkUnassignedReferences "if [[ -v \"foo[1]\" ]]; then echo ${foo[@]}; fi" prop_checkUnassignedReferences33= verifyNotTree checkUnassignedReferences "f() { local -A foo; echo \"${foo[@]}\"; }" +prop_checkUnassignedReferences34= verifyNotTree checkUnassignedReferences "declare -A foo; (( foo[bar] ))" checkUnassignedReferences params t = warnings where (readMap, writeMap) = execState (mapM tally $ variableFlow params) (Map.empty, Map.empty) @@ -2540,7 +2540,7 @@ checkLoopVariableReassignment params token = T_ForArithmetic _ (TA_Sequence _ [TA_Assignment _ "=" - (TA_Expansion _ [T_Literal _ var]) _]) + (TA_Variable _ var _ ) _]) _ _ _ -> return var _ -> fail "not loop" diff --git a/ShellCheck/AnalyzerLib.hs b/ShellCheck/AnalyzerLib.hs index efb4aea..bc4ad5e 100644 --- a/ShellCheck/AnalyzerLib.hs +++ b/ShellCheck/AnalyzerLib.hs @@ -444,15 +444,12 @@ getModifiedVariables t = c@T_SimpleCommand {} -> getModifiedVariableCommand c - TA_Unary _ "++|" var -> maybeToList $ do - name <- getLiteralString var - return (t, t, name, DataString $ SourceFrom [t]) - TA_Unary _ "|++" var -> maybeToList $ do - name <- getLiteralString var - return (t, t, name, DataString $ SourceFrom [t]) - TA_Assignment _ op lhs rhs -> maybeToList $ do + TA_Unary _ "++|" v@(TA_Variable _ name _) -> + [(t, v, name, DataString $ SourceFrom [v])] + TA_Unary _ "|++" v@(TA_Variable _ name _) -> + [(t, v, name, DataString $ SourceFrom [v])] + TA_Assignment _ op (TA_Variable _ name _) rhs -> maybeToList $ do guard $ op `elem` ["=", "*=", "/=", "%=", "+=", "-=", "<<=", ">>=", "&=", "^=", "|="] - name <- getLiteralString lhs return (t, t, name, DataString $ SourceFrom [rhs]) -- Count [[ -v foo ]] as an "assignment". @@ -634,10 +631,10 @@ getReferencedVariables parents t = map (\x -> (l, l, x)) ( getIndexReferences str ++ getOffsetReferences (getBracedModifier str)) - TA_Expansion id _ -> + TA_Variable id name _ -> if isArithmeticAssignment t then [] - else getIfReference t t + else [(t, t, name)] T_Assignment id mode str _ word -> [(t, t, str) | mode == Append] ++ specialReferences str t word @@ -664,7 +661,6 @@ getReferencedVariables parents t = else [] literalizer t = case t of - TA_Index {} -> return "" -- x[0] becomes a reference of x T_Glob _ s -> return s -- Also when parsed as globs _ -> Nothing diff --git a/ShellCheck/Checks/ShellSupport.hs b/ShellCheck/Checks/ShellSupport.hs index f2ca2da..b219ea1 100644 --- a/ShellCheck/Checks/ShellSupport.hs +++ b/ShellCheck/Checks/ShellSupport.hs @@ -191,11 +191,9 @@ checkBashisms = ForShell [Sh, Dash] $ \t -> do bashism (T_Glob id str) | "[^" `isInfixOf` str = warnMsg id "^ in place of ! in glob bracket expressions is" - bashism t@(TA_Expansion id _) | isBashism = - warnMsg id $ fromJust str ++ " is" - where - str = getLiteralString t - isBashism = isJust str && isBashVariable (fromJust str) + bashism t@(TA_Variable id str _) | isBashVariable str = + warnMsg id $ str ++ " is" + bashism t@(T_DollarBraced id token) = do mapM_ check expansion when (isBashVariable var) $ diff --git a/ShellCheck/Parser.hs b/ShellCheck/Parser.hs index 9ae9953..185972a 100644 --- a/ShellCheck/Parser.hs +++ b/ShellCheck/Parser.hs @@ -697,31 +697,35 @@ readArithmeticContents = spacing1 return (str, alt) - readArrayIndex = do id <- getNextId char '[' - middle <- readArithmeticContents + pos <- getPosition + middle <- readStringForParser readArithmeticContents char ']' - return $ TA_Index id middle + return $ T_UnparsedIndex id pos middle literal s = do id <- getNextId string s return $ T_Literal id s - readArithmeticLiteral = - readArrayIndex <|> literal "#" + readVariable = do + id <- getNextId + name <- readVariableName + indices <- many readArrayIndex + spacing + return $ TA_Variable id name indices readExpansion = do id <- getNextId pieces <- many1 $ choice [ - readArithmeticLiteral, readSingleQuoted, readDoubleQuoted, readNormalDollar, readBraced, readUnquotedBackTicked, + literal "#", readNormalLiteral "+-*/=%^,]?:" ] spacing @@ -734,7 +738,7 @@ readArithmeticContents = spacing return s - readArithTerm = readGroup <|> readExpansion + readArithTerm = readGroup <|> readVariable <|> readExpansion readSequence = do spacing @@ -2819,10 +2823,7 @@ readScriptFile = do readUtf8Bom = called "Byte Order Mark" $ string "\xFEFF" -readScript = do - script <- readScriptFile - reparseIndices script - +readScript = readScriptFile -- Interactively run a parser in ghci: -- debugParse readScript "echo 'hello world'" @@ -2945,6 +2946,9 @@ reparseIndices root = return $ T_Array id2 newWords x -> return x return $ T_Assignment id mode name newIndices newValue + f (TA_Variable id name indices) = do + newIndices <- mapM (fixAssignmentIndex name) indices + return $ TA_Variable id name newIndices f t = return t fixIndexElement name word = @@ -2952,13 +2956,13 @@ reparseIndices root = T_IndexedElement id indices value -> do new <- mapM (fixAssignmentIndex name) indices return $ T_IndexedElement id new value - otherwise -> return word + _ -> return word fixAssignmentIndex name word = case word of - T_UnparsedIndex id pos src -> do + T_UnparsedIndex id pos src -> parsed name pos src - otherwise -> return word + _ -> return word parsed name pos src = if isAssociative name