mirror of
https://github.com/koalaman/shellcheck
synced 2025-07-10 23:32:57 -07:00
Scan for Gentoo eclass variables
Creates a Map of eclass names to eclass variables by scanning the system for repositories and their respective eclasses. Runs `portageq` to determine repository names and locations. Emits a warning if an IOException is caught when attempting to run `portageq`. This Map is passed via CheckSpec to AnalysisSpec and finally to Parameters, where it is read by `checkUnusedAssignments` in order to determine which variables can be safely ignored by this check. Signed-off-by: hololeap <hololeap@users.noreply.github.com>
This commit is contained in:
parent
08ae7ef836
commit
272ef819b9
8 changed files with 58 additions and 18 deletions
|
@ -93,11 +93,11 @@ library
|
|||
ShellCheck.Formatter.Quiet
|
||||
ShellCheck.Interface
|
||||
ShellCheck.Parser
|
||||
ShellCheck.PortageVariables
|
||||
ShellCheck.Prelude
|
||||
ShellCheck.Regex
|
||||
other-modules:
|
||||
Paths_ShellCheck
|
||||
ShellCheck.PortageVariables
|
||||
ShellCheck.PortageAutoInternalVariables
|
||||
default-language: Haskell98
|
||||
|
||||
|
|
|
@ -21,6 +21,7 @@ import qualified ShellCheck.Analyzer
|
|||
import ShellCheck.Checker
|
||||
import ShellCheck.Data
|
||||
import ShellCheck.Interface
|
||||
import ShellCheck.PortageVariables
|
||||
import ShellCheck.Regex
|
||||
|
||||
import qualified ShellCheck.Formatter.CheckStyle
|
||||
|
@ -240,10 +241,22 @@ runFormatter sys format options files = do
|
|||
either (reportFailure filename) check input
|
||||
where
|
||||
check contents = do
|
||||
|
||||
-- If this is a Gentoo ebuild file, scan for eclasses on the system
|
||||
gentooData <- case getPortageFileType filename of
|
||||
NonPortageRelated -> pure Map.empty
|
||||
_ -> catch (portageVariables <$> scanRepos) $ \e -> do
|
||||
let warnMsg = "Error when scanning for Gentoo repos: "
|
||||
let err = show (e :: IOException)
|
||||
hPutStr stderr ("Warning: " ++ warnMsg ++ err)
|
||||
pure Map.empty
|
||||
|
||||
let checkspec = (checkSpec options) {
|
||||
csFilename = filename,
|
||||
csScript = contents
|
||||
csScript = contents,
|
||||
csGentooData = gentooData
|
||||
}
|
||||
|
||||
result <- checkScript sys checkspec
|
||||
onResult format result sys
|
||||
return $
|
||||
|
|
|
@ -2412,7 +2412,10 @@ allInternalVariables params =
|
|||
genericInternalVariables ++
|
||||
if shellType params == Ksh then kshInternalVariables else [] ++
|
||||
if isPortageBuild params
|
||||
then portageInternalVariables (getInheritedEclasses (rootNode params))
|
||||
then
|
||||
let eclasses = getInheritedEclasses $ rootNode params
|
||||
gMap = gentooData params
|
||||
in portageInternalVariables eclasses gMap
|
||||
else []
|
||||
|
||||
prop_checkUnused0 = verifyNotTree checkUnusedAssignments "var=foo; echo $var"
|
||||
|
|
|
@ -27,6 +27,7 @@ import qualified ShellCheck.CFGAnalysis as CF
|
|||
import ShellCheck.Data
|
||||
import ShellCheck.Interface
|
||||
import ShellCheck.Parser
|
||||
import ShellCheck.PortageVariables
|
||||
import ShellCheck.Prelude
|
||||
import ShellCheck.Regex
|
||||
|
||||
|
@ -104,6 +105,8 @@ data Parameters = Parameters {
|
|||
tokenPositions :: Map.Map Id (Position, Position),
|
||||
-- detailed type of any Portage related file
|
||||
portageFileType :: PortageFileType,
|
||||
-- Gentoo-specific data
|
||||
gentooData :: EclassMap,
|
||||
-- Result from Control Flow Graph analysis (including data flow analysis)
|
||||
cfgAnalysis :: CF.CFGAnalysis
|
||||
} deriving (Show)
|
||||
|
@ -243,6 +246,7 @@ makeParameters spec = params
|
|||
variableFlow = getVariableFlow params root,
|
||||
tokenPositions = asTokenPositions spec,
|
||||
portageFileType = asPortageFileType spec,
|
||||
gentooData = asGentooData spec,
|
||||
cfgAnalysis = CF.analyzeControlFlow cfParams root
|
||||
}
|
||||
cfParams = CF.CFGParameters {
|
||||
|
|
|
@ -89,7 +89,8 @@ checkScript sys spec = do
|
|||
asExecutionMode = Executed,
|
||||
asTokenPositions = tokenPositions,
|
||||
asOptionalChecks = getEnableDirectives root ++ csOptionalChecks spec,
|
||||
asPortageFileType = getPortageFileType $ csFilename spec
|
||||
asPortageFileType = getPortageFileType $ csFilename spec,
|
||||
asGentooData = csGentooData spec
|
||||
} where as = newAnalysisSpec root
|
||||
let analysisMessages =
|
||||
maybe []
|
||||
|
|
|
@ -2,6 +2,7 @@ module ShellCheck.Data where
|
|||
|
||||
import qualified Data.Map
|
||||
import ShellCheck.Interface
|
||||
import ShellCheck.PortageVariables
|
||||
import ShellCheck.PortageAutoInternalVariables
|
||||
import Data.Version (showVersion)
|
||||
|
||||
|
@ -149,14 +150,15 @@ portageManualInternalVariables = [
|
|||
"LINGUAS"
|
||||
]
|
||||
|
||||
eclassVarsFromMap :: String -> [String]
|
||||
eclassVarsFromMap eclass =
|
||||
eclassVarsFromMap :: EclassMap -> String -> [String]
|
||||
eclassVarsFromMap gMap eclass =
|
||||
Data.Map.findWithDefault []
|
||||
eclass
|
||||
portageAutoInternalVariables
|
||||
gMap
|
||||
|
||||
portageInternalVariables inheritedEclasses =
|
||||
portageManualInternalVariables ++ concatMap eclassVarsFromMap
|
||||
portageInternalVariables :: [String] -> EclassMap -> [String]
|
||||
portageInternalVariables inheritedEclasses gMap =
|
||||
portageManualInternalVariables ++ concatMap (eclassVarsFromMap gMap)
|
||||
inheritedEclasses
|
||||
|
||||
specialIntegerVariables = [
|
||||
|
|
|
@ -21,11 +21,11 @@
|
|||
module ShellCheck.Interface
|
||||
(
|
||||
SystemInterface(..)
|
||||
, CheckSpec(csFilename, csScript, csCheckSourced, csIncludedWarnings, csExcludedWarnings, csShellTypeOverride, csMinSeverity, csIgnoreRC, csOptionalChecks)
|
||||
, CheckSpec(csFilename, csScript, csCheckSourced, csIncludedWarnings, csExcludedWarnings, csShellTypeOverride, csMinSeverity, csIgnoreRC, csOptionalChecks, csGentooData)
|
||||
, CheckResult(crFilename, crComments)
|
||||
, ParseSpec(psFilename, psScript, psCheckSourced, psIgnoreRC, psShellTypeOverride)
|
||||
, ParseResult(prComments, prTokenPositions, prRoot)
|
||||
, AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks, asPortageFileType)
|
||||
, AnalysisSpec(asScript, asShellType, asFallbackShell, asExecutionMode, asCheckSourced, asTokenPositions, asOptionalChecks, asPortageFileType, asGentooData)
|
||||
, AnalysisResult(arComments)
|
||||
, FormatterOptions(foColorOption, foWikiLinkCount)
|
||||
, Shell(Ksh, Sh, Bash, Dash)
|
||||
|
@ -63,6 +63,7 @@ module ShellCheck.Interface
|
|||
) where
|
||||
|
||||
import ShellCheck.AST
|
||||
import ShellCheck.PortageVariables (EclassMap)
|
||||
|
||||
import Control.DeepSeq
|
||||
import Control.Monad.Identity
|
||||
|
@ -101,7 +102,8 @@ data CheckSpec = CheckSpec {
|
|||
csIncludedWarnings :: Maybe [Integer],
|
||||
csShellTypeOverride :: Maybe Shell,
|
||||
csMinSeverity :: Severity,
|
||||
csOptionalChecks :: [String]
|
||||
csOptionalChecks :: [String],
|
||||
csGentooData :: EclassMap
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data CheckResult = CheckResult {
|
||||
|
@ -125,7 +127,8 @@ emptyCheckSpec = CheckSpec {
|
|||
csIncludedWarnings = Nothing,
|
||||
csShellTypeOverride = Nothing,
|
||||
csMinSeverity = StyleC,
|
||||
csOptionalChecks = []
|
||||
csOptionalChecks = [],
|
||||
csGentooData = Map.empty
|
||||
}
|
||||
|
||||
newParseSpec :: ParseSpec
|
||||
|
@ -182,7 +185,8 @@ data AnalysisSpec = AnalysisSpec {
|
|||
asCheckSourced :: Bool,
|
||||
asOptionalChecks :: [String],
|
||||
asTokenPositions :: Map.Map Id (Position, Position),
|
||||
asPortageFileType :: PortageFileType
|
||||
asPortageFileType :: PortageFileType,
|
||||
asGentooData :: EclassMap
|
||||
}
|
||||
|
||||
newAnalysisSpec token = AnalysisSpec {
|
||||
|
@ -193,7 +197,8 @@ newAnalysisSpec token = AnalysisSpec {
|
|||
asCheckSourced = False,
|
||||
asOptionalChecks = [],
|
||||
asTokenPositions = Map.empty,
|
||||
asPortageFileType = NonPortageRelated
|
||||
asPortageFileType = NonPortageRelated,
|
||||
asGentooData = Map.empty
|
||||
}
|
||||
|
||||
newtype AnalysisResult = AnalysisResult {
|
||||
|
|
|
@ -2,7 +2,9 @@
|
|||
module ShellCheck.PortageVariables
|
||||
( RepoName
|
||||
, RepoPath
|
||||
, EclassName
|
||||
, EclassVar
|
||||
, EclassMap
|
||||
, Repository(..)
|
||||
, Eclass(..)
|
||||
, portageVariables
|
||||
|
@ -18,14 +20,19 @@ import qualified Data.Map as M
|
|||
import System.Directory (listDirectory)
|
||||
import System.Exit (ExitCode(..))
|
||||
import System.FilePath
|
||||
import System.Process -- (readProcessWithExitCode)
|
||||
import System.Process
|
||||
import Text.Parsec hiding ((<|>))
|
||||
import Text.Parsec.String
|
||||
|
||||
type RepoName = String
|
||||
type RepoPath = FilePath
|
||||
type EclassName = String
|
||||
type EclassVar = String
|
||||
|
||||
-- | This is used for looking up what eclass variables are inherited,
|
||||
-- keyed by the name of the eclass.
|
||||
type EclassMap = M.Map EclassName [EclassVar]
|
||||
|
||||
data Repository = Repository
|
||||
{ repositoryName :: RepoName
|
||||
, repositoryLocation :: RepoPath
|
||||
|
@ -33,11 +40,12 @@ data Repository = Repository
|
|||
} deriving (Show, Eq, Ord)
|
||||
|
||||
data Eclass = Eclass
|
||||
{ eclassName :: String
|
||||
{ eclassName :: EclassName
|
||||
, eclassVars :: [EclassVar]
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
portageVariables :: [Repository] -> Map String [EclassVar]
|
||||
-- | Map from eclass names to a list of eclass variables
|
||||
portageVariables :: [Repository] -> EclassMap
|
||||
portageVariables = foldMap $ foldMap go . repositoryEclasses
|
||||
where
|
||||
go e = M.singleton (eclassName e) (eclassVars e)
|
||||
|
@ -91,9 +99,11 @@ reposParser =
|
|||
endOfBlock :: Parser ()
|
||||
endOfBlock = void endOfLine <|> eof
|
||||
|
||||
-- cons the repo and continue parsing
|
||||
insert :: (RepoName, RepoPath) -> Parser [(RepoName, RepoPath)]
|
||||
insert r = (r:) <$> reposParser
|
||||
|
||||
-- skip the repo and continue parsing
|
||||
ignore :: Parser [(RepoName, RepoPath)]
|
||||
ignore = reposParser
|
||||
|
||||
|
@ -116,6 +126,8 @@ getEclasses repoLoc = fmap (maybe [] id) $ runMaybeT $ do
|
|||
Left pe -> lift $ fail $ show pe
|
||||
Right vs -> pure $ Eclass n vs
|
||||
|
||||
-- | Scan a @.eclass@ file for any @@@ECLASS_VARIABLE:@ comments, generating
|
||||
-- a list of eclass variables.
|
||||
eclassParser :: Parser [EclassVar]
|
||||
eclassParser = choice
|
||||
[ -- cons the EclassVar to the list and continue
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue