diff --git a/ShellCheck/AST.hs b/ShellCheck/AST.hs index 35bbf43..be2043e 100644 --- a/ShellCheck/AST.hs +++ b/ShellCheck/AST.hs @@ -128,7 +128,7 @@ data Token = | T_Include Id Token Token -- . & source: SimpleCommand T_Script deriving (Show) -data Annotation = DisableComment Integer deriving (Show, Eq) +data Annotation = DisableComment Integer | SourceOverride String deriving (Show, Eq) data ConditionType = DoubleBracket | SingleBracket deriving (Show, Eq) -- This is an abomination. diff --git a/ShellCheck/Checker.hs b/ShellCheck/Checker.hs index a000a13..002ad1c 100644 --- a/ShellCheck/Checker.hs +++ b/ShellCheck/Checker.hs @@ -86,11 +86,13 @@ getErrors sys spec = where getCode (PositionedComment _ (Comment _ code _)) = code -check str = +check = checkWithIncludes [] + +checkWithIncludes includes src = getErrors - (mockedSystemInterface []) + (mockedSystemInterface includes) emptyCheckSpec { - csScript = str, + csScript = src, csExcludedWarnings = [2148] } @@ -124,45 +126,34 @@ prop_optionDisablesIssue2 = csExcludedWarnings = [2148, 1037] } +prop_canParseDevNull = + [] == check "source /dev/null" + prop_failsWhenNotSourcing = - [1091, 2154] == getErrors - (mockedSystemInterface []) - emptyCheckSpec { - csScript = "source lob; echo \"$bar\"", - csExcludedWarnings = [2148] - } + [1091, 2154] == check "source lol; echo \"$bar\"" prop_worksWhenSourcing = - null $ getErrors - (mockedSystemInterface [("lib", "bar=1")]) - emptyCheckSpec { - csScript = "source lib; echo \"$bar\"", - csExcludedWarnings = [2148] - } + null $ checkWithIncludes [("lib", "bar=1")] "source lib; echo \"$bar\"" prop_worksWhenDotting = - null $ getErrors - (mockedSystemInterface [("lib", "bar=1")]) - emptyCheckSpec { - csScript = ". lib; echo \"$bar\"", - csExcludedWarnings = [2148] - } + null $ checkWithIncludes [("lib", "bar=1")] ". lib; echo \"$bar\"" prop_noInfiniteSourcing = - [] == getErrors - (mockedSystemInterface [("lib", "source lib")]) - emptyCheckSpec { - csScript = "source lib", - csExcludedWarnings = [2148] - } + [] == checkWithIncludes [("lib", "source lib")] "source lib" prop_canSourceBadSyntax = - [1094, 2086] == getErrors - (mockedSystemInterface [("lib", "for f; do")]) - emptyCheckSpec { - csScript = "source lib; echo $1", - csExcludedWarnings = [2148] - } + [1094, 2086] == checkWithIncludes [("lib", "for f; do")] "source lib; echo $1" + +prop_cantSourceDynamic = + [1090] == checkWithIncludes [("lib", "")] ". \"$1\"" + +prop_canSourceDynamicWhenRedirected = + null $ checkWithIncludes [("lib", "")] "#shellcheck source=lib\n. \"$1\"" + +prop_sourceDirectiveDoesntFollowFile = + null $ checkWithIncludes + [("foo", "source bar"), ("bar", "baz=3")] + "#shellcheck source=foo\n. \"$1\"; echo \"$baz\"" return [] runTests = $quickCheckAll diff --git a/ShellCheck/Parser.hs b/ShellCheck/Parser.hs index 49232f1..f13002d 100644 --- a/ShellCheck/Parser.hs +++ b/ShellCheck/Parser.hs @@ -32,6 +32,7 @@ import Data.Char import Data.Functor import Data.List (isPrefixOf, isInfixOf, isSuffixOf, partition, sortBy, intercalate, nub) import Data.Maybe +import Data.Monoid import Debug.Trace import GHC.Exts (sortWith) import Prelude hiding (readList) @@ -191,6 +192,7 @@ shouldIgnoreCode code = do disabling (ContextSource _) = True -- Don't add messages for sourced files disabling _ = False disabling' (DisableComment n) = code == n + disabling' _ = False shouldFollow file = do context <- getCurrentContexts @@ -209,6 +211,18 @@ shouldFollow file = do isThisFile (ContextSource name) | name == file = True isThisFile _= False +getSourceOverride = do + context <- getCurrentContexts + return . msum . map findFile $ takeWhile isSameFile context + where + isSameFile (ContextSource _) = False + isSameFile _ = True + + findFile (ContextAnnotation list) = msum $ map getFile list + findFile _ = Nothing + getFile (SourceOverride str) = Just str + getFile _ = Nothing + -- Store potential parse problems outside of parsec data SystemState = SystemState { @@ -722,10 +736,11 @@ readAnnotationPrefix = do prop_readAnnotation1 = isOk readAnnotation "# shellcheck disable=1234,5678\n" prop_readAnnotation2 = isOk readAnnotation "# shellcheck disable=SC1234 disable=SC5678\n" +prop_readAnnotation3 = isOk readAnnotation "# shellcheck disable=SC1234 source=/dev/null disable=SC5678\n" readAnnotation = called "shellcheck annotation" $ do try readAnnotationPrefix many1 linewhitespace - values <- many1 readDisable + values <- many1 (readDisable <|> readSourceOverride) linefeed many linewhitespace return $ concat values @@ -737,6 +752,11 @@ readAnnotation = called "shellcheck annotation" $ do optional $ string "SC" int <- many1 digit return $ DisableComment (read int) + + readSourceOverride = forKey "source" $ do + filename <- many1 $ noneOf " \n" + return [SourceOverride filename] + forKey s p = do try $ string s char '=' @@ -1480,11 +1500,12 @@ readSimpleCommand = called "simple command" $ do readSource :: Monad m => SourcePos -> Token -> SCParser m Token readSource pos t@(T_Redirecting _ _ (T_SimpleCommand _ _ (cmd:file:_))) = do - let literalFile = getLiteralString file + override <- getSourceOverride + let literalFile = override `mplus` getLiteralString file case literalFile of Nothing -> do - parseNoteAt pos InfoC 1090 - "This source will be skipped since it's not constant." + parseNoteAt pos WarningC 1090 + "Can't follow non-constant source. Use a directive to specify location." return t Just filename -> do proceed <- shouldFollow filename @@ -1495,7 +1516,10 @@ readSource pos t@(T_Redirecting _ _ (T_SimpleCommand _ _ (cmd:file:_))) = do return t else do sys <- Mr.ask - input <- system $ siReadFile sys filename + input <- + if filename == "/dev/null" -- always allow /dev/null + then return (Right "") + else system $ siReadFile sys filename case input of Left err -> do parseNoteAt pos InfoC 1091 $ diff --git a/shellcheck.1.md b/shellcheck.1.md index 9d4be0f..619a30c 100644 --- a/shellcheck.1.md +++ b/shellcheck.1.md @@ -58,7 +58,8 @@ not warn at all, as `ksh` supports decimals in arithmetic contexts. : Follow 'source' statements even when the file is not specified as input. By default, `shellcheck` will only follow files specified on the command - line. This option allows following any file the script may `source`. + line (plus `/dev/null`). This option allows following any file the script + may `source`. # FORMATS @@ -125,7 +126,12 @@ For example, to suppress SC2035 about using `./*.jpg`: # shellcheck disable=SC2035 echo "Files: " *.jpg -Here a shell brace group is used to suppress on multiple lines: +To tell ShellCheck where to look for an otherwise dynamically determined file: + + # shellcheck source=./lib.sh + source "$(find_install_dir)/lib.sh" + +Here a shell brace group is used to suppress a warning on multiple lines: # shellcheck disable=SC2016 { @@ -140,6 +146,11 @@ Valid keys are: The command can be a simple command like `echo foo`, or a compound command like a function definition, subshell block or loop. +**source** +: Overrides the filename included by a `source`/`.` statement. This can be + used to tell shellcheck where to look for a file whose name is determined + at runtime, or to skip a source by telling it to use `/dev/null`. + # AUTHOR ShellCheck is written and maintained by Vidar Holen.