Control Flow Graph / Data Flow Analysis support

This commit is contained in:
Vidar Holen 2022-07-19 14:23:27 -07:00
parent 7946bf5657
commit f77a545282
17 changed files with 2909 additions and 135 deletions

View File

@ -5,6 +5,10 @@
### Fixed
### Changed
- ShellCheck now has a Data Flow Analysis engine to make smarter decisions
based on control flow rather than just syntax. Existing checks will
gradually start using it, which may cause them to trigger differently
(but more accurately).
## v0.8.0 - 2021-11-06

View File

@ -53,6 +53,7 @@ library
deepseq >= 1.4.0.0,
Diff >= 0.2.0,
directory >= 1.2.3.0,
fgl,
mtl >= 2.2.1,
filepath,
parsec,
@ -66,11 +67,15 @@ library
ShellCheck.Analytics
ShellCheck.Analyzer
ShellCheck.AnalyzerLib
ShellCheck.CFG
ShellCheck.CFGAnalysis
ShellCheck.Checker
ShellCheck.Checks.Commands
ShellCheck.Checks.ControlFlow
ShellCheck.Checks.Custom
ShellCheck.Checks.ShellSupport
ShellCheck.Data
ShellCheck.Debug
ShellCheck.Fixer
ShellCheck.Formatter.Format
ShellCheck.Formatter.CheckStyle
@ -82,6 +87,7 @@ library
ShellCheck.Formatter.Quiet
ShellCheck.Interface
ShellCheck.Parser
ShellCheck.Prelude
ShellCheck.Regex
other-modules:
Paths_ShellCheck
@ -100,6 +106,7 @@ executable shellcheck
deepseq >= 1.4.0.0,
Diff >= 0.2.0,
directory >= 1.2.3.0,
fgl,
mtl >= 2.2.1,
filepath,
parsec >= 3.0,
@ -120,6 +127,7 @@ test-suite test-shellcheck
deepseq >= 1.4.0.0,
Diff >= 0.2.0,
directory >= 1.2.3.0,
fgl,
mtl >= 2.2.1,
filepath,
parsec,

View File

@ -21,6 +21,7 @@
module ShellCheck.ASTLib where
import ShellCheck.AST
import ShellCheck.Prelude
import ShellCheck.Regex
import Control.Monad.Writer
@ -138,7 +139,7 @@ getFlagsUntil stopCondition (T_SimpleCommand _ _ (_:args)) =
flag (x, '-':'-':arg) = [ (x, takeWhile (/= '=') arg) ]
flag (x, '-':args) = map (\v -> (x, [v])) args
flag (x, _) = [ (x, "") ]
getFlagsUntil _ _ = error "Internal shellcheck error, please report! (getFlags on non-command)"
getFlagsUntil _ _ = error $ pleaseReport "getFlags on non-command"
-- Get all flags in a GNU way, up until --
getAllFlags :: Token -> [(Token, String)]
@ -785,5 +786,118 @@ executableFromShebang = shellFor
basename s = reverse . takeWhile (/= '/') . reverse $ s
skipFlags = dropWhile ("-" `isPrefixOf`)
-- Determining if a name is a variable
isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x
isVariableChar x = isVariableStartChar x || isDigit x
isSpecialVariableChar = (`elem` "*@#?-$!")
variableNameRegex = mkRegex "[_a-zA-Z][_a-zA-Z0-9]*"
prop_isVariableName1 = isVariableName "_fo123"
prop_isVariableName2 = not $ isVariableName "4"
prop_isVariableName3 = not $ isVariableName "test: "
isVariableName (x:r) = isVariableStartChar x && all isVariableChar r
isVariableName _ = False
-- Get the variable name from an expansion like ${var:-foo}
prop_getBracedReference1 = getBracedReference "foo" == "foo"
prop_getBracedReference2 = getBracedReference "#foo" == "foo"
prop_getBracedReference3 = getBracedReference "#" == "#"
prop_getBracedReference4 = getBracedReference "##" == "#"
prop_getBracedReference5 = getBracedReference "#!" == "!"
prop_getBracedReference6 = getBracedReference "!#" == "#"
prop_getBracedReference7 = getBracedReference "!foo#?" == "foo"
prop_getBracedReference8 = getBracedReference "foo-bar" == "foo"
prop_getBracedReference9 = getBracedReference "foo:-bar" == "foo"
prop_getBracedReference10= getBracedReference "foo: -1" == "foo"
prop_getBracedReference11= getBracedReference "!os*" == ""
prop_getBracedReference11b= getBracedReference "!os@" == ""
prop_getBracedReference12= getBracedReference "!os?bar**" == ""
prop_getBracedReference13= getBracedReference "foo[bar]" == "foo"
getBracedReference s = fromMaybe s $
nameExpansion s `mplus` takeName noPrefix `mplus` getSpecial noPrefix `mplus` getSpecial s
where
noPrefix = dropPrefix s
dropPrefix (c:rest) | c `elem` "!#" = rest
dropPrefix cs = cs
takeName s = do
let name = takeWhile isVariableChar s
guard . not $ null name
return name
getSpecial (c:_) | isSpecialVariableChar c = return [c]
getSpecial _ = fail "empty or not special"
nameExpansion ('!':next:rest) = do -- e.g. ${!foo*bar*}
guard $ isVariableChar next -- e.g. ${!@}
first <- find (not . isVariableChar) rest
guard $ first `elem` "*?@"
return ""
nameExpansion _ = Nothing
-- Get the variable modifier like /a/b in ${var/a/b}
prop_getBracedModifier1 = getBracedModifier "foo:bar:baz" == ":bar:baz"
prop_getBracedModifier2 = getBracedModifier "!var:-foo" == ":-foo"
prop_getBracedModifier3 = getBracedModifier "foo[bar]" == "[bar]"
prop_getBracedModifier4 = getBracedModifier "foo[@]@Q" == "[@]@Q"
prop_getBracedModifier5 = getBracedModifier "@@Q" == "@Q"
getBracedModifier s = headOrDefault "" $ do
let var = getBracedReference s
a <- dropModifier s
dropPrefix var a
where
dropPrefix [] t = return t
dropPrefix (a:b) (c:d) | a == c = dropPrefix b d
dropPrefix _ _ = []
dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest]
dropModifier x = [x]
-- Get the variables from indices like ["x", "y"] in ${var[x+y+1]}
prop_getIndexReferences1 = getIndexReferences "var[x+y+1]" == ["x", "y"]
getIndexReferences s = fromMaybe [] $ do
match <- matchRegex re s
index <- match !!! 0
return $ matchAllStrings variableNameRegex index
where
re = mkRegex "(\\[.*\\])"
prop_getOffsetReferences1 = getOffsetReferences ":bar" == ["bar"]
prop_getOffsetReferences2 = getOffsetReferences ":bar:baz" == ["bar", "baz"]
prop_getOffsetReferences3 = getOffsetReferences "[foo]:bar" == ["bar"]
prop_getOffsetReferences4 = getOffsetReferences "[foo]:bar:baz" == ["bar", "baz"]
getOffsetReferences mods = fromMaybe [] $ do
-- if mods start with [, then drop until ]
match <- matchRegex re mods
offsets <- match !!! 1
return $ matchAllStrings variableNameRegex offsets
where
re = mkRegex "^(\\[.+\\])? *:([^-=?+].*)"
-- Returns whether a token is a parameter expansion without any modifiers.
-- True for $var ${var} $1 $#
-- False for ${#var} ${var[x]} ${var:-0}
isUnmodifiedParameterExpansion t =
case t of
T_DollarBraced _ False _ -> True
T_DollarBraced _ _ list ->
let str = concat $ oversimplify list
in getBracedReference str == str
_ -> False
--- A list of the element and all its parents up to the root node.
getPath tree t = t :
case Map.lookup (getId t) tree of
Nothing -> []
Just parent -> getPath tree parent
isClosingFileOp op =
case op of
T_IoDuplicate _ (T_GREATAND _) "-" -> True
T_IoDuplicate _ (T_LESSAND _) "-" -> True
_ -> False
return []
runTests = $quickCheckAll

View File

@ -24,8 +24,10 @@ module ShellCheck.Analytics (runAnalytics, optionalChecks, ShellCheck.Analytics.
import ShellCheck.AST
import ShellCheck.ASTLib
import ShellCheck.AnalyzerLib hiding (producesComments)
import qualified ShellCheck.CFGAnalysis as CF
import ShellCheck.Data
import ShellCheck.Parser
import ShellCheck.Prelude
import ShellCheck.Interface
import ShellCheck.Regex

View File

@ -25,6 +25,7 @@ import ShellCheck.Interface
import Data.List
import Data.Monoid
import qualified ShellCheck.Checks.Commands
import qualified ShellCheck.Checks.ControlFlow
import qualified ShellCheck.Checks.Custom
import qualified ShellCheck.Checks.ShellSupport
@ -42,11 +43,13 @@ analyzeScript spec = newAnalysisResult {
checkers spec params = mconcat $ map ($ params) [
ShellCheck.Checks.Commands.checker spec,
ShellCheck.Checks.ControlFlow.checker spec,
ShellCheck.Checks.Custom.checker,
ShellCheck.Checks.ShellSupport.checker
]
optionalChecks = mconcat $ [
ShellCheck.Analytics.optionalChecks,
ShellCheck.Checks.Commands.optionalChecks
ShellCheck.Checks.Commands.optionalChecks,
ShellCheck.Checks.ControlFlow.optionalChecks
]

View File

@ -23,9 +23,11 @@ module ShellCheck.AnalyzerLib where
import ShellCheck.AST
import ShellCheck.ASTLib
import qualified ShellCheck.CFGAnalysis as CF
import ShellCheck.Data
import ShellCheck.Interface
import ShellCheck.Parser
import ShellCheck.Prelude
import ShellCheck.Regex
import Control.Arrow (first)
@ -96,7 +98,9 @@ data Parameters = Parameters {
-- The root node of the AST
rootNode :: Token,
-- map from token id to start and end position
tokenPositions :: Map.Map Id (Position, Position)
tokenPositions :: Map.Map Id (Position, Position),
-- Result from Control Flow Graph analysis (including data flow analysis)
cfgAnalysis :: CF.CFGAnalysis
} deriving (Show)
-- TODO: Cache results of common AST ops here
@ -189,8 +193,9 @@ makeCommentWithFix severity id code str fix =
}
in force withFix
makeParameters spec =
let params = Parameters {
makeParameters spec = params
where
params = Parameters {
rootNode = root,
shellType = fromMaybe (determineShell (asFallbackShell spec) root) $ asShellType spec,
hasSetE = containsSetE root,
@ -215,9 +220,14 @@ makeParameters spec =
shellTypeSpecified = isJust (asShellType spec) || isJust (asFallbackShell spec),
parentMap = getParentTree root,
variableFlow = getVariableFlow params root,
tokenPositions = asTokenPositions spec
} in params
where root = asScript spec
tokenPositions = asTokenPositions spec,
cfgAnalysis = CF.analyzeControlFlow cfParams root
}
cfParams = CF.CFGParameters {
CF.cfLastpipe = hasLastpipe params,
CF.cfPipefail = hasPipefail params
}
root = asScript spec
-- Does this script mention 'set -e' anywhere?
@ -408,12 +418,6 @@ usedAsCommandName tree token = go (getId token) (tail $ getPath tree token)
getId word == currentId || getId (getCommandTokenOrThis t) == currentId
go _ _ = False
-- A list of the element and all its parents up to the root node.
getPath tree t = t :
case Map.lookup (getId t) tree of
Nothing -> []
Just parent -> getPath tree parent
-- Version of the above taking the map from the current context
-- Todo: give this the name "getPath"
getPathM t = do
@ -559,12 +563,6 @@ getModifiedVariables t =
return (place, t, str, DataString SourceChecked)
_ -> Nothing
isClosingFileOp op =
case op of
T_IoDuplicate _ (T_GREATAND _) "-" -> True
T_IoDuplicate _ (T_LESSAND _) "-" -> True
_ -> False
-- Consider 'export/declare -x' a reference, since it makes the var available
getReferencedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Literal _ x:_):rest)) =
@ -746,13 +744,6 @@ getModifiedVariableCommand base@(T_SimpleCommand id cmdPrefix (T_NormalWord _ (T
getModifiedVariableCommand _ = []
getIndexReferences s = fromMaybe [] $ do
match <- matchRegex re s
index <- match !!! 0
return $ matchAllStrings variableNameRegex index
where
re = mkRegex "(\\[.*\\])"
-- Given a NormalWord like foo or foo[$bar], get foo.
-- Primarily used to get references for [[ -v foo[bar] ]]
getVariableForTestDashV :: Token -> Maybe String
@ -767,18 +758,6 @@ getVariableForTestDashV t = do
-- in a non-constant expression (while filtering out foo$x[$y])
toStr _ = return "\0"
prop_getOffsetReferences1 = getOffsetReferences ":bar" == ["bar"]
prop_getOffsetReferences2 = getOffsetReferences ":bar:baz" == ["bar", "baz"]
prop_getOffsetReferences3 = getOffsetReferences "[foo]:bar" == ["bar"]
prop_getOffsetReferences4 = getOffsetReferences "[foo]:bar:baz" == ["bar", "baz"]
getOffsetReferences mods = fromMaybe [] $ do
-- if mods start with [, then drop until ]
match <- matchRegex re mods
offsets <- match !!! 1
return $ matchAllStrings variableNameRegex offsets
where
re = mkRegex "^(\\[.+\\])? *:([^-=?+].*)"
getReferencedVariables parents t =
case t of
T_DollarBraced id _ l -> let str = concat $ oversimplify l in
@ -857,17 +836,6 @@ isConfusedGlobRegex ('*':_) = True
isConfusedGlobRegex [x,'*'] | x `notElem` "\\." = True
isConfusedGlobRegex _ = False
isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x
isVariableChar x = isVariableStartChar x || isDigit x
isSpecialVariableChar = (`elem` "*@#?-$!")
variableNameRegex = mkRegex "[_a-zA-Z][_a-zA-Z0-9]*"
prop_isVariableName1 = isVariableName "_fo123"
prop_isVariableName2 = not $ isVariableName "4"
prop_isVariableName3 = not $ isVariableName "test: "
isVariableName (x:r) = isVariableStartChar x && all isVariableChar r
isVariableName _ = False
getVariablesFromLiteralToken token =
getVariablesFromLiteral (getLiteralStringDef " " token)
@ -880,73 +848,6 @@ getVariablesFromLiteral string =
where
variableRegex = mkRegex "\\$\\{?([A-Za-z0-9_]+)"
-- Get the variable name from an expansion like ${var:-foo}
prop_getBracedReference1 = getBracedReference "foo" == "foo"
prop_getBracedReference2 = getBracedReference "#foo" == "foo"
prop_getBracedReference3 = getBracedReference "#" == "#"
prop_getBracedReference4 = getBracedReference "##" == "#"
prop_getBracedReference5 = getBracedReference "#!" == "!"
prop_getBracedReference6 = getBracedReference "!#" == "#"
prop_getBracedReference7 = getBracedReference "!foo#?" == "foo"
prop_getBracedReference8 = getBracedReference "foo-bar" == "foo"
prop_getBracedReference9 = getBracedReference "foo:-bar" == "foo"
prop_getBracedReference10= getBracedReference "foo: -1" == "foo"
prop_getBracedReference11= getBracedReference "!os*" == ""
prop_getBracedReference11b= getBracedReference "!os@" == ""
prop_getBracedReference12= getBracedReference "!os?bar**" == ""
prop_getBracedReference13= getBracedReference "foo[bar]" == "foo"
getBracedReference s = fromMaybe s $
nameExpansion s `mplus` takeName noPrefix `mplus` getSpecial noPrefix `mplus` getSpecial s
where
noPrefix = dropPrefix s
dropPrefix (c:rest) | c `elem` "!#" = rest
dropPrefix cs = cs
takeName s = do
let name = takeWhile isVariableChar s
guard . not $ null name
return name
getSpecial (c:_) | isSpecialVariableChar c = return [c]
getSpecial _ = fail "empty or not special"
nameExpansion ('!':next:rest) = do -- e.g. ${!foo*bar*}
guard $ isVariableChar next -- e.g. ${!@}
first <- find (not . isVariableChar) rest
guard $ first `elem` "*?@"
return ""
nameExpansion _ = Nothing
prop_getBracedModifier1 = getBracedModifier "foo:bar:baz" == ":bar:baz"
prop_getBracedModifier2 = getBracedModifier "!var:-foo" == ":-foo"
prop_getBracedModifier3 = getBracedModifier "foo[bar]" == "[bar]"
prop_getBracedModifier4 = getBracedModifier "foo[@]@Q" == "[@]@Q"
prop_getBracedModifier5 = getBracedModifier "@@Q" == "@Q"
getBracedModifier s = headOrDefault "" $ do
let var = getBracedReference s
a <- dropModifier s
dropPrefix var a
where
dropPrefix [] t = return t
dropPrefix (a:b) (c:d) | a == c = dropPrefix b d
dropPrefix _ _ = []
dropModifier (c:rest) | c `elem` "#!" = [rest, c:rest]
dropModifier x = [x]
-- Useful generic functions.
-- Get element 0 or a default. Like `head` but safe.
headOrDefault _ (a:_) = a
headOrDefault def _ = def
-- Get the last element or a default. Like `last` but safe.
lastOrDefault def [] = def
lastOrDefault _ list = last list
--- Get element n of a list, or Nothing. Like `!!` but safe.
(!!!) list i =
case drop i list of
[] -> Nothing
(r:_) -> Just r
-- Run a command if the shell is in the given list
whenShell l c = do
@ -999,17 +900,6 @@ isBashLike params =
Dash -> False
Sh -> False
-- Returns whether a token is a parameter expansion without any modifiers.
-- True for $var ${var} $1 $#
-- False for ${#var} ${var[x]} ${var:-0}
isUnmodifiedParameterExpansion t =
case t of
T_DollarBraced _ False _ -> True
T_DollarBraced _ _ list ->
let str = concat $ oversimplify list
in getBracedReference str == str
_ -> False
isTrueAssignmentSource c =
case c of
DataString SourceChecked -> False

1147
src/ShellCheck/CFG.hs Normal file

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -30,6 +30,7 @@ import ShellCheck.AnalyzerLib
import ShellCheck.Data
import ShellCheck.Interface
import ShellCheck.Parser
import ShellCheck.Prelude
import ShellCheck.Regex
import Control.Monad

View File

@ -0,0 +1,101 @@
{-
Copyright 2022 Vidar Holen
This file is part of ShellCheck.
https://www.shellcheck.net
ShellCheck is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
ShellCheck is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE TemplateHaskell #-}
-- Checks that run on the Control Flow Graph (as opposed to the AST)
-- This is scaffolding for a work in progress.
module ShellCheck.Checks.ControlFlow (checker, optionalChecks, ShellCheck.Checks.ControlFlow.runTests) where
import ShellCheck.AST
import ShellCheck.ASTLib
import ShellCheck.CFG hiding (cfgAnalysis)
import ShellCheck.CFGAnalysis
import ShellCheck.AnalyzerLib
import ShellCheck.Data
import ShellCheck.Interface
import Control.Monad
import Control.Monad.Reader
import Data.Graph.Inductive.Graph
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List
import Data.Maybe
import Test.QuickCheck.All (forAllProperties)
import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess)
optionalChecks :: [CheckDescription]
optionalChecks = []
-- A check that runs on the entire graph
type ControlFlowCheck = Analysis
-- A check invoked once per node, with its (pre,post) data
type ControlFlowNodeCheck = LNode CFNode -> (ProgramState, ProgramState) -> Analysis
-- A check invoked once per effect, with its node's (pre,post) data
type ControlFlowEffectCheck = IdTagged CFEffect -> Node -> (ProgramState, ProgramState) -> Analysis
checker :: AnalysisSpec -> Parameters -> Checker
checker spec params = Checker {
perScript = const $ sequence_ controlFlowChecks,
perToken = const $ return ()
}
controlFlowChecks :: [ControlFlowCheck]
controlFlowChecks = [
runNodeChecks controlFlowNodeChecks
]
controlFlowNodeChecks :: [ControlFlowNodeCheck]
controlFlowNodeChecks = [
runEffectChecks controlFlowEffectChecks
]
controlFlowEffectChecks :: [ControlFlowEffectCheck]
controlFlowEffectChecks = [
]
runNodeChecks :: [ControlFlowNodeCheck] -> ControlFlowCheck
runNodeChecks perNode = do
cfg <- asks cfgAnalysis
runOnAll cfg
where
getData datas n@(node, label) = do
(pre, post) <- M.lookup node datas
return (n, (pre, post))
runOn :: (LNode CFNode, (ProgramState, ProgramState)) -> Analysis
runOn (node, prepost) = mapM_ (\c -> c node prepost) perNode
runOnAll cfg = mapM_ runOn $ mapMaybe (getData $ nodeToData cfg) $ labNodes (graph cfg)
runEffectChecks :: [ControlFlowEffectCheck] -> ControlFlowNodeCheck
runEffectChecks list = checkNode
where
checkNode (node, label) prepost =
case label of
CFApplyEffects effects -> mapM_ (\effect -> mapM_ (\c -> c effect node prepost) list) effects
_ -> return ()
return []
runTests = $( [| $(forAllProperties) (quickCheckWithResult (stdArgs { maxSuccess = 1 }) ) |])

View File

@ -25,6 +25,7 @@ import ShellCheck.AST
import ShellCheck.ASTLib
import ShellCheck.AnalyzerLib
import ShellCheck.Interface
import ShellCheck.Prelude
import ShellCheck.Regex
import Control.Monad

View File

@ -2,9 +2,27 @@ module ShellCheck.Data where
import ShellCheck.Interface
import Data.Version (showVersion)
import Paths_ShellCheck (version)
shellcheckVersion = showVersion version -- VERSIONSTRING
{-
If you are here because you saw an error about Paths_ShellCheck in this file,
simply comment out the import below and define the version as a constant string.
Instead of:
import Paths_ShellCheck (version)
shellcheckVersion = showVersion version
Use:
-- import Paths_ShellCheck (version)
shellcheckVersion = "kludge"
-}
import Paths_ShellCheck (version)
shellcheckVersion = showVersion version -- VERSIONSTRING
internalVariables = [
-- Generic
@ -43,9 +61,12 @@ internalVariables = [
"flags_error", "flags_return"
]
specialVariablesWithoutSpaces = [
"$", "-", "?", "!", "#"
specialIntegerVariables = [
"$", "?", "!", "#"
]
specialVariablesWithoutSpaces = "-" : specialIntegerVariables
variablesWithoutSpaces = specialVariablesWithoutSpaces ++ [
"BASHPID", "BASH_ARGC", "BASH_LINENO", "BASH_SUBSHELL", "EUID", "LINENO",
"OPTIND", "PPID", "RANDOM", "SECONDS", "SHELLOPTS", "SHLVL", "UID",

313
src/ShellCheck/Debug.hs Normal file
View File

@ -0,0 +1,313 @@
{-
This file contains useful functions for debugging and developing ShellCheck.
To invoke them interactively, run:
cabal repl
At the ghci prompt, enter:
:load ShellCheck.Debug
You can now invoke the functions. Here are some examples:
shellcheckString "echo $1"
stringToAst "(( x+1 ))"
stringToCfg "if foo; then bar; else baz; fi"
writeFile "/tmp/test.dot" $ stringToCfgViz "while foo; do bar; done"
The latter file can be rendered to png with GraphViz:
dot -Tpng /tmp/test.dot > /tmp/test.png
To run all unit tests in a module:
ShellCheck.Parser.runTests
ShellCheck.Analytics.runTests
To run a specific test:
:load ShellCheck.Analytics
prop_checkUuoc3
If you make code changes, reload in seconds at any time with:
:r
===========================================================================
Crash course in printf debugging in Haskell:
import Debug.Trace
greet 0 = return ()
-- Print when a function is invoked
greet n | trace ("calling greet " ++ show n) False = undefined
greet n = do
putStrLn "Enter name"
name <- getLine
-- Print at some point in any monadic function
traceM $ "user entered " ++ name
putStrLn $ "Hello " ++ name
-- Print a value before passing it on
greet $ traceShowId (n - 1)
===========================================================================
If you want to invoke `ghci` directly, such as on `shellcheck.hs`, to
debug all of ShellCheck including I/O, you may see an error like this:
src/ShellCheck/Data.hs:5:1: error:
Could not load module Paths_ShellCheck
it is a hidden module in the package ShellCheck-0.8.0
This can easily be circumvented by running `./setgitversion` or manually
editing src/ShellCheck/Data.hs to replace the auto-deduced version number
with a constant string as indicated.
Afterwards, you can run the ShellCheck tool, as if from the shell, with:
$ ghci shellcheck.hs
ghci> runMain ["-x", "file.sh"]
-}
module ShellCheck.Debug () where
import ShellCheck.Analyzer
import ShellCheck.AST
import ShellCheck.CFG
import ShellCheck.Checker
import ShellCheck.CFGAnalysis as CF
import ShellCheck.Interface
import ShellCheck.Parser
import ShellCheck.Prelude
import Control.Monad
import Control.Monad.Identity
import Control.Monad.RWS
import Control.Monad.Writer
import Data.Graph.Inductive.Graph as G
import Data.List
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Set as S
-- Run all of ShellCheck (minus output formatters)
shellcheckString :: String -> CheckResult
shellcheckString scriptString =
runIdentity $ checkScript dummySystemInterface checkSpec
where
checkSpec :: CheckSpec
checkSpec = emptyCheckSpec {
csScript = scriptString
}
dummySystemInterface :: SystemInterface Identity
dummySystemInterface = mockedSystemInterface [
-- A tiny, fake filesystem for sourced files
("lib/mylib1.sh", "foo=$(cat $1 | wc -l)"),
("lib/mylib2.sh", "bar=42")
]
-- Parameters used when generating Control Flow Graphs
cfgParams :: CFGParameters
cfgParams = CFGParameters {
cfLastpipe = False,
cfPipefail = False
}
-- An example script to play with
exampleScript :: String
exampleScript = unlines [
"#!/bin/sh",
"count=0",
"for file in *",
"do",
" (( count++ ))",
"done",
"echo $count"
]
-- Parse the script string into ShellCheck's ParseResult
parseScriptString :: String -> ParseResult
parseScriptString scriptString =
runIdentity $ parseScript dummySystemInterface parseSpec
where
parseSpec :: ParseSpec
parseSpec = newParseSpec {
psFilename = "myscript",
psScript = scriptString
}
-- Parse the script string into an Abstract Syntax Tree
stringToAst :: String -> Token
stringToAst scriptString =
case maybeRoot of
Just root -> root
Nothing -> error $ "Script failed to parse: " ++ show parserWarnings
where
parseResult :: ParseResult
parseResult = parseScriptString scriptString
maybeRoot :: Maybe Token
maybeRoot = prRoot parseResult
parserWarnings :: [PositionedComment]
parserWarnings = prComments parseResult
astToCfgResult :: Token -> CFGResult
astToCfgResult = buildGraph cfgParams
astToDfa :: Token -> CFGAnalysis
astToDfa = analyzeControlFlow cfgParams
astToCfg :: Token -> CFGraph
astToCfg = cfGraph . astToCfgResult
stringToCfg :: String -> CFGraph
stringToCfg = astToCfg . stringToAst
stringToDfa :: String -> CFGAnalysis
stringToDfa = astToDfa . stringToAst
cfgToGraphViz :: CFGraph -> String
cfgToGraphViz = cfgToGraphVizWith show
stringToCfgViz :: String -> String
stringToCfgViz = cfgToGraphViz . stringToCfg
stringToDfaViz :: String -> String
stringToDfaViz = dfaToGraphViz . stringToDfa
-- Dump a Control Flow Graph as GraphViz with extended information
stringToDetailedCfgViz :: String -> String
stringToDetailedCfgViz scriptString = cfgToGraphVizWith nodeLabel graph
where
ast :: Token
ast = stringToAst scriptString
cfgResult :: CFGResult
cfgResult = astToCfgResult ast
graph :: CFGraph
graph = cfGraph cfgResult
idToToken :: M.Map Id Token
idToToken = M.fromList $ execWriter $ doAnalysis (\c -> tell [(getId c, c)]) ast
idToNode :: M.Map Id (Node, Node)
idToNode = cfIdToNode cfgResult
nodeToStartIds :: M.Map Node (S.Set Id)
nodeToStartIds =
M.fromListWith S.union $
map (\(id, (start, _)) -> (start, S.singleton id)) $
M.toList idToNode
nodeToEndIds :: M.Map Node (S.Set Id)
nodeToEndIds =
M.fromListWith S.union $
map (\(id, (_, end)) -> (end, S.singleton id)) $
M.toList idToNode
formatId :: Id -> String
formatId id = fromMaybe ("Unknown " ++ show id) $ do
(OuterToken _ token) <- M.lookup id idToToken
firstWord <- words (show token) !!! 0
-- Strip off "Inner_"
(_ : tokenName) <- return $ dropWhile (/= '_') firstWord
return $ tokenName ++ " " ++ show id
formatGroup :: S.Set Id -> String
formatGroup set = intercalate ", " $ map formatId $ S.toList set
nodeLabel (node, label) = unlines [
show node ++ ". " ++ show label,
"Begin: " ++ formatGroup (M.findWithDefault S.empty node nodeToStartIds),
"End: " ++ formatGroup (M.findWithDefault S.empty node nodeToEndIds)
]
-- Dump a Control Flow Graph with Data Flow Analysis as GraphViz
dfaToGraphViz :: CF.CFGAnalysis -> String
dfaToGraphViz analysis = cfgToGraphVizWith label $ CF.graph analysis
where
label (node, label) =
let
desc = show node ++ ". " ++ show label
in
fromMaybe ("No DFA available\n\n" ++ desc) $ do
(pre, post) <- M.lookup node $ CF.nodeToData analysis
return $ unlines [
"Precondition: " ++ show pre,
"",
desc,
"",
"Postcondition: " ++ show post
]
-- Dump an Control Flow Graph to GraphViz with a given node formatter
cfgToGraphVizWith :: (LNode CFNode -> String) -> CFGraph -> String
cfgToGraphVizWith nodeLabel graph = concat [
"digraph {\n",
concatMap dumpNode (labNodes graph),
concatMap dumpLink (labEdges graph),
tagVizEntries graph,
"}\n"
]
where
dumpNode l@(node, label) = show node ++ " [label=" ++ quoteViz (nodeLabel l) ++ "]\n"
dumpLink (from, to, typ) = show from ++ " -> " ++ show to ++ " [style=" ++ quoteViz (edgeStyle typ) ++ "]\n"
edgeStyle CFEFlow = "solid"
edgeStyle CFEExit = "bold"
edgeStyle CFEFalseFlow = "dotted"
quoteViz str = "\"" ++ escapeViz str ++ "\""
escapeViz [] = []
escapeViz (c:rest) =
case c of
'\"' -> '\\' : '\"' : escapeViz rest
'\n' -> '\\' : 'l' : escapeViz rest
'\\' -> '\\' : '\\' : escapeViz rest
_ -> c : escapeViz rest
-- Dump an Abstract Syntax Tree (or branch thereof) to GraphViz format
astToGraphViz :: Token -> String
astToGraphViz token = concat [
"digraph {\n",
formatTree token,
"}\n"
]
where
formatTree :: Token -> String
formatTree t = snd $ execRWS (doStackAnalysis push pop t) () []
push :: Token -> RWS () String [Int] ()
push (OuterToken (Id n) inner) = do
stack <- get
put (n : stack)
case stack of
[] -> return ()
(top:_) -> tell $ show top ++ " -> " ++ show n ++ "\n"
tell $ show n ++ " [label=" ++ quoteViz (show n ++ ": " ++ take 32 (show inner)) ++ "]\n"
pop :: Token -> RWS () String [Int] ()
pop _ = modify tail
-- For each entry point, set the rank so that they'll align in the graph
tagVizEntries :: CFGraph -> String
tagVizEntries graph = "{ rank=same " ++ rank ++ " }"
where
entries = mapMaybe find $ labNodes graph
find (node, CFEntryPoint name) = return (node, name)
find _ = Nothing
rank = unwords $ map (\(c, _) -> show c) entries

View File

@ -22,6 +22,7 @@
module ShellCheck.Fixer (applyFix, removeTabStops, mapPositions, Ranged(..), runTests) where
import ShellCheck.Interface
import ShellCheck.Prelude
import Control.Monad.State
import Data.Array
import Data.List
@ -228,7 +229,7 @@ applyReplacement2 rep string = do
let (l1, l2) = tmap posLine originalPos in
when (l1 /= 1 || l2 /= 1) $
error "ShellCheck internal error, please report: bad cross-line fix"
error $ pleaseReport "bad cross-line fix"
let replacer = repString rep
let shift = (length replacer) - (oldEnd - oldStart)

View File

@ -27,6 +27,7 @@ import ShellCheck.AST
import ShellCheck.ASTLib hiding (runTests)
import ShellCheck.Data
import ShellCheck.Interface
import ShellCheck.Prelude
import Control.Applicative ((<*), (*>))
import Control.Monad
@ -210,7 +211,7 @@ getNextIdSpanningTokenList list =
-- Get the span covered by an id
getSpanForId :: Monad m => Id -> SCParser m (SourcePos, SourcePos)
getSpanForId id =
Map.findWithDefault (error "Internal error: no position for id. Please report!") id <$>
Map.findWithDefault (error $ pleaseReport "no parser span for id") id <$>
getMap
-- Create a new id with the same span as an existing one
@ -1918,7 +1919,7 @@ readPendingHereDocs = do
-- The end token is just a prefix
skipLine
| hasTrailer ->
error "ShellCheck bug, please report (here doc trailer)."
error $ pleaseReport "unexpected heredoc trailer"
-- The following cases assume no trailing text:
| dashed == Undashed && (not $ null leadingSpace) -> do

48
src/ShellCheck/Prelude.hs Normal file
View File

@ -0,0 +1,48 @@
{-
Copyright 2022 Vidar Holen
This file is part of ShellCheck.
https://www.shellcheck.net
ShellCheck is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
ShellCheck is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
-}
-- Generic basic utility functions
module ShellCheck.Prelude where
-- Get element 0 or a default. Like `head` but safe.
headOrDefault _ (a:_) = a
headOrDefault def _ = def
-- Get the last element or a default. Like `last` but safe.
lastOrDefault def [] = def
lastOrDefault _ list = last list
--- Get element n of a list, or Nothing. Like `!!` but safe.
(!!!) list i =
case drop i list of
[] -> Nothing
(r:_) -> Just r
-- Like mconcat but for Semigroups
sconcat1 :: (Semigroup t) => [t] -> t
sconcat1 [x] = x
sconcat1 (x:xs) = x <> sconcat1 xs
sconcatOrDefault def [] = def
sconcatOrDefault _ list = sconcat1 list
-- For more actionable "impossible" errors
pleaseReport str = "ShellCheck internal error, please report: " ++ str

View File

@ -5,8 +5,11 @@ import System.Exit
import qualified ShellCheck.Analytics
import qualified ShellCheck.AnalyzerLib
import qualified ShellCheck.ASTLib
import qualified ShellCheck.CFG
import qualified ShellCheck.CFGAnalysis
import qualified ShellCheck.Checker
import qualified ShellCheck.Checks.Commands
import qualified ShellCheck.Checks.ControlFlow
import qualified ShellCheck.Checks.Custom
import qualified ShellCheck.Checks.ShellSupport
import qualified ShellCheck.Fixer
@ -19,8 +22,11 @@ main = do
ShellCheck.Analytics.runTests
,ShellCheck.AnalyzerLib.runTests
,ShellCheck.ASTLib.runTests
,ShellCheck.CFG.runTests
,ShellCheck.CFGAnalysis.runTests
,ShellCheck.Checker.runTests
,ShellCheck.Checks.Commands.runTests
,ShellCheck.Checks.ControlFlow.runTests
,ShellCheck.Checks.Custom.runTests
,ShellCheck.Checks.ShellSupport.runTests
,ShellCheck.Fixer.runTests