From 0df934514298adadc40651696d5b854784efa0a5 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Tue, 2 Aug 2022 11:25:35 -0700 Subject: [PATCH] Trace numerical status, use for SC2071 (ref #2541) --- src/ShellCheck/Analytics.hs | 21 +++++++-- src/ShellCheck/CFGAnalysis.hs | 84 ++++++++++++++++++++++++++--------- 2 files changed, 82 insertions(+), 23 deletions(-) diff --git a/src/ShellCheck/Analytics.hs b/src/ShellCheck/Analytics.hs index e878dc4..b5bac35 100644 --- a/src/ShellCheck/Analytics.hs +++ b/src/ShellCheck/Analytics.hs @@ -1167,6 +1167,10 @@ prop_checkNumberComparisons18 = verify checkNumberComparisons "[[ foo -eq 2 ]]" prop_checkNumberComparisons19 = verifyNot checkNumberComparisons "foo=1; [[ foo -eq 2 ]]" prop_checkNumberComparisons20 = verify checkNumberComparisons "[[ 2 -eq / ]]" prop_checkNumberComparisons21 = verify checkNumberComparisons "[[ foo -eq foo ]]" +prop_checkNumberComparisons22 = verify checkNumberComparisons "x=10; [[ $x > $z ]]" +prop_checkNumberComparisons23 = verify checkNumberComparisons "x=0; if [[ -n $def ]]; then x=$def; fi; while [ $x > $z ]; do lol; done" +prop_checkNumberComparisons24 = verify checkNumberComparisons "x=$RANDOM; [ $x > $z ]" +prop_checkNumberComparisons25 = verify checkNumberComparisons "[[ $((n++)) > $x ]]" checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do if isNum lhs || isNum rhs @@ -1242,9 +1246,20 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do numChar x = isDigit x || x `elem` "+-. " isNum t = - case oversimplify t of - [v] -> all isDigit v - _ -> False + case getWordParts t of + [T_DollarArithmetic {}] -> True + [b@(T_DollarBraced id _ c)] -> + let + str = concat $ oversimplify c + var = getBracedReference str + in fromMaybe False $ do + state <- CF.getIncomingState (cfgAnalysis params) id + value <- Map.lookup var $ CF.variablesInScope state + return $ CF.numericalStatus (CF.variableValue value) >= CF.NumericalStatusMaybe + _ -> + case oversimplify t of + [v] -> all isDigit v + _ -> False isFraction t = case oversimplify t of diff --git a/src/ShellCheck/CFGAnalysis.hs b/src/ShellCheck/CFGAnalysis.hs index e6b1701..634d354 100644 --- a/src/ShellCheck/CFGAnalysis.hs +++ b/src/ShellCheck/CFGAnalysis.hs @@ -54,29 +54,31 @@ module ShellCheck.CFGAnalysis ( ,VariableValue (..) ,VariableProperties ,SpaceStatus (..) + ,NumericalStatus (..) ,getIncomingState ,getOutgoingState ,doesPostDominate ,ShellCheck.CFGAnalysis.runTests -- STRIP ) where -import GHC.Generics (Generic) -import ShellCheck.AST -import ShellCheck.CFG -import qualified ShellCheck.Data as Data -import ShellCheck.Prelude +import Control.DeepSeq import Control.Monad import Control.Monad.ST -import Control.DeepSeq -import Data.List hiding (map) import Data.Array.Unboxed -import Data.STRef -import Data.Maybe -import qualified Data.Map as M -import qualified Data.Set as S +import Data.Char import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Query.DFS +import Data.List hiding (map) +import Data.Maybe +import Data.STRef import Debug.Trace -- STRIP +import GHC.Generics (Generic) +import qualified Data.Map as M +import qualified Data.Set as S +import qualified ShellCheck.Data as Data +import ShellCheck.AST +import ShellCheck.CFG +import ShellCheck.Prelude import Test.QuickCheck @@ -183,16 +185,20 @@ createEnvironmentState = do foldl' (flip ($)) newInternalState $ concat [ addVars Data.internalVariables unknownVariableState, addVars Data.variablesWithoutSpaces spacelessVariableState, - addVars Data.specialIntegerVariables spacelessVariableState + addVars Data.specialIntegerVariables integerVariableState ] where addVars names val = map (\name -> insertGlobal name val) names spacelessVariableState = unknownVariableState { variableValue = VariableValue { literalValue = Nothing, - spaceStatus = SpaceStatusClean + spaceStatus = SpaceStatusClean, + numericalStatus = NumericalStatusUnknown } } + integerVariableState = unknownVariableState { + variableValue = unknownIntegerValue + } modified s = s { sVersion = -1 } @@ -289,7 +295,8 @@ unknownFunctionValue = S.singleton FunctionUnknown -- The information about the value of a single variable data VariableValue = VariableValue { literalValue :: Maybe String, -- TODO: For debugging. Remove me. - spaceStatus :: SpaceStatus + spaceStatus :: SpaceStatus, + numericalStatus :: NumericalStatus } deriving (Show, Eq, Ord, Generic, NFData) @@ -301,6 +308,9 @@ data VariableState = VariableState { -- Whether or not the value needs quoting (has spaces/globs), or we don't know data SpaceStatus = SpaceStatusEmpty | SpaceStatusClean | SpaceStatusDirty deriving (Show, Eq, Ord, Generic, NFData) +-- +-- Whether or not the value needs quoting (has spaces/globs), or we don't know +data NumericalStatus = NumericalStatusUnknown | NumericalStatusEmpty | NumericalStatusMaybe | NumericalStatusDefinitely deriving (Show, Eq, Ord, Generic, NFData) -- The set of possible sets of properties for this variable type VariableProperties = S.Set (S.Set CFVariableProp) @@ -314,12 +324,14 @@ unknownVariableState = VariableState { unknownVariableValue = VariableValue { literalValue = Nothing, - spaceStatus = SpaceStatusDirty + spaceStatus = SpaceStatusDirty, + numericalStatus = NumericalStatusUnknown } emptyVariableValue = unknownVariableValue { literalValue = Just "", - spaceStatus = SpaceStatusEmpty + spaceStatus = SpaceStatusEmpty, + numericalStatus = NumericalStatusEmpty } unsetVariableState = VariableState { @@ -334,7 +346,8 @@ mergeVariableState a b = VariableState { mergeVariableValue a b = VariableValue { literalValue = if literalValue a == literalValue b then literalValue a else Nothing, - spaceStatus = mergeSpaceStatus (spaceStatus a) (spaceStatus b) + spaceStatus = mergeSpaceStatus (spaceStatus a) (spaceStatus b), + numericalStatus = mergeNumericalStatus (numericalStatus a) (numericalStatus b) } mergeSpaceStatus a b = @@ -344,6 +357,16 @@ mergeSpaceStatus a b = (SpaceStatusClean, SpaceStatusClean) -> SpaceStatusClean _ -> SpaceStatusDirty +mergeNumericalStatus a b = + case (a,b) of + (NumericalStatusDefinitely, NumericalStatusDefinitely) -> NumericalStatusDefinitely + (NumericalStatusDefinitely, _) -> NumericalStatusMaybe + (_, NumericalStatusDefinitely) -> NumericalStatusMaybe + (NumericalStatusMaybe, _) -> NumericalStatusMaybe + (_, NumericalStatusMaybe) -> NumericalStatusMaybe + (NumericalStatusEmpty, NumericalStatusEmpty) -> NumericalStatusEmpty + _ -> NumericalStatusUnknown + -- A VersionedMap is a Map that keeps an additional integer version to quickly determine if it has changed. -- * Version -1 means it's unknown (possibly and presumably changed) -- * Version 0 means it's empty @@ -1154,7 +1177,8 @@ appendVariableValue :: VariableValue -> VariableValue -> VariableValue appendVariableValue a b = unknownVariableValue { literalValue = liftM2 (++) (literalValue a) (literalValue b), - spaceStatus = appendSpaceStatus (spaceStatus a) (spaceStatus b) + spaceStatus = appendSpaceStatus (spaceStatus a) (spaceStatus b), + numericalStatus = appendNumericalStatus (numericalStatus a) (numericalStatus b) } appendSpaceStatus a b = @@ -1164,14 +1188,25 @@ appendSpaceStatus a b = (SpaceStatusClean, SpaceStatusClean) -> a _ ->SpaceStatusDirty +appendNumericalStatus a b = + case (a,b) of + (NumericalStatusEmpty, x) -> x + (x, NumericalStatusEmpty) -> x + (NumericalStatusDefinitely, NumericalStatusDefinitely) -> NumericalStatusDefinitely + (NumericalStatusUnknown, _) -> NumericalStatusUnknown + (_, NumericalStatusUnknown) -> NumericalStatusUnknown + _ -> NumericalStatusMaybe + unknownIntegerValue = unknownVariableValue { literalValue = Nothing, - spaceStatus = SpaceStatusClean + spaceStatus = SpaceStatusClean, + numericalStatus = NumericalStatusDefinitely } literalToVariableValue str = unknownVariableValue { literalValue = Just str, - spaceStatus = literalToSpaceStatus str + spaceStatus = literalToSpaceStatus str, + numericalStatus = literalToNumericalStatus str } withoutChanges ctx f = do @@ -1191,6 +1226,15 @@ literalToSpaceStatus str = _ | all (`notElem` " \t\n*?[") str -> SpaceStatusClean _ -> SpaceStatusDirty +-- Get the NumericalStatus for a literal string, i.e. whether it's an integer +literalToNumericalStatus str = + case str of + "" -> NumericalStatusEmpty + '-':rest -> if isNumeric rest then NumericalStatusDefinitely else NumericalStatusUnknown + rest -> if isNumeric rest then NumericalStatusDefinitely else NumericalStatusUnknown + where + isNumeric = all isDigit + type StateMap = M.Map Node (InternalState, InternalState) -- Classic, iterative Data Flow Analysis. See Wikipedia for a description of the process.