"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "src/ShellCheck/ASTLib.hs" between
shellcheck-0.8.0.tar.gz and shellcheck-0.9.0.tar.gz

About: ShellCheck is a static analysis and linting tool for sh/bash scripts (written in Haskell).

ASTLib.hs  (shellcheck-0.8.0):ASTLib.hs  (shellcheck-0.9.0)
skipping to change at line 24 skipping to change at line 24
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details. GNU General Public License for more details.
You should have received a copy of the GNU General Public License You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module ShellCheck.ASTLib where module ShellCheck.ASTLib where
import ShellCheck.AST import ShellCheck.AST
import ShellCheck.Prelude
import ShellCheck.Regex import ShellCheck.Regex
import Control.Monad.Writer import Control.Monad.Writer
import Control.Monad import Control.Monad
import Data.Char import Data.Char
import Data.Functor import Data.Functor
import Data.Functor.Identity import Data.Functor.Identity
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import qualified Data.Map as Map import qualified Data.Map as Map
skipping to change at line 139 skipping to change at line 140
-- stringFlag == "". -- stringFlag == "".
getFlagsUntil stopCondition (T_SimpleCommand _ _ (_:args)) = getFlagsUntil stopCondition (T_SimpleCommand _ _ (_:args)) =
let tokenAndText = map (\x -> (x, concat $ oversimplify x)) args let tokenAndText = map (\x -> (x, concat $ oversimplify x)) args
(flagArgs, rest) = break (stopCondition . snd) tokenAndText (flagArgs, rest) = break (stopCondition . snd) tokenAndText
in in
concatMap flag flagArgs ++ map (\(t, _) -> (t, "")) rest concatMap flag flagArgs ++ map (\(t, _) -> (t, "")) rest
where where
flag (x, '-':'-':arg) = [ (x, takeWhile (/= '=') arg) ] flag (x, '-':'-':arg) = [ (x, takeWhile (/= '=') arg) ]
flag (x, '-':args) = map (\v -> (x, [v])) args flag (x, '-':args) = map (\v -> (x, [v])) args
flag (x, _) = [ (x, "") ] flag (x, _) = [ (x, "") ]
getFlagsUntil _ _ = error "Internal shellcheck error, please report! (getFlags o n non-command)" getFlagsUntil _ _ = error $ pleaseReport "getFlags on non-command"
-- Get all flags in a GNU way, up until -- -- Get all flags in a GNU way, up until --
getAllFlags :: Token -> [(Token, String)] getAllFlags :: Token -> [(Token, String)]
getAllFlags = getFlagsUntil (== "--") getAllFlags = getFlagsUntil (== "--")
-- Get all flags in a BSD way, up until first non-flag argument or -- -- Get all flags in a BSD way, up until first non-flag argument or --
getLeadingFlags = getFlagsUntil (\x -> x == "--" || (not $ "-" `isPrefixOf` x)) getLeadingFlags = getFlagsUntil (\x -> x == "--" || (not $ "-" `isPrefixOf` x))
-- Check if a command has a flag. -- Check if a command has a flag.
hasFlag cmd str = str `elem` (map snd $ getAllFlags cmd) hasFlag cmd str = str `elem` (map snd $ getAllFlags cmd)
skipping to change at line 368 skipping to change at line 369
where where
from ((T_Literal _ s):rest) = s ++ from rest from ((T_Literal _ s):rest) = s ++ from rest
from _ = "" from _ = ""
-- Maybe get the literal string of this token and any globs in it. -- Maybe get the literal string of this token and any globs in it.
getGlobOrLiteralString = getLiteralStringExt f getGlobOrLiteralString = getLiteralStringExt f
where where
f (T_Glob _ str) = return str f (T_Glob _ str) = return str
f _ = Nothing f _ = Nothing
prop_getLiteralString1 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x01")
== Just "\1"
prop_getLiteralString2 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\xyz")
== Just "\\xyz"
prop_getLiteralString3 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x1") =
= Just "\x1"
prop_getLiteralString4 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x1y")
== Just "\x1y"
prop_getLiteralString5 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\xy") =
= Just "\\xy"
prop_getLiteralString6 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\x") ==
Just "\\x"
prop_getLiteralString7 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\1x") =
= Just "\1x"
prop_getLiteralString8 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\12x")
== Just "\o12x"
prop_getLiteralString9 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\123x")
== Just "\o123x"
prop_getLiteralString10 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\1234"
) == Just "\o123\&4"
prop_getLiteralString11 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\1") =
= Just "\1"
prop_getLiteralString12 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\12")
== Just "\o12"
prop_getLiteralString13 = getLiteralString (T_DollarSingleQuoted (Id 0) "\\123")
== Just "\o123"
-- Maybe get the literal value of a token, using a custom function -- Maybe get the literal value of a token, using a custom function
-- to map unrecognized Tokens into strings. -- to map unrecognized Tokens into strings.
getLiteralStringExt :: Monad m => (Token -> m String) -> Token -> m String getLiteralStringExt :: Monad m => (Token -> m String) -> Token -> m String
getLiteralStringExt more = g getLiteralStringExt more = g
where where
allInList = fmap concat . mapM g allInList = fmap concat . mapM g
g (T_DoubleQuoted _ l) = allInList l g (T_DoubleQuoted _ l) = allInList l
g (T_DollarDoubleQuoted _ l) = allInList l g (T_DollarDoubleQuoted _ l) = allInList l
g (T_NormalWord _ l) = allInList l g (T_NormalWord _ l) = allInList l
g (TA_Expansion _ l) = allInList l g (TA_Expansion _ l) = allInList l
skipping to change at line 400 skipping to change at line 415
'f' -> '\f' : rest 'f' -> '\f' : rest
'n' -> '\n' : rest 'n' -> '\n' : rest
'r' -> '\r' : rest 'r' -> '\r' : rest
't' -> '\t' : rest 't' -> '\t' : rest
'v' -> '\v' : rest 'v' -> '\v' : rest
'\'' -> '\'' : rest '\'' -> '\'' : rest
'"' -> '"' : rest '"' -> '"' : rest
'\\' -> '\\' : rest '\\' -> '\\' : rest
'x' -> 'x' ->
case cs of case cs of
(x:y:more) -> (x:y:more) | isHexDigit x && isHexDigit y ->
if isHexDigit x && isHexDigit y chr (16*(digitToInt x) + (digitToInt y)) : decodeEscapes
then chr (16*(digitToInt x) + (digitToInt y)) : rest more
else '\\':c:rest (x:more) | isHexDigit x ->
chr (digitToInt x) : decodeEscapes more
more -> '\\' : 'x' : decodeEscapes more
_ | isOctDigit c -> _ | isOctDigit c ->
let digits = take 3 $ takeWhile isOctDigit (c:cs) let (digits, more) = spanMax isOctDigit 3 (c:cs)
num = parseOct digits num = (parseOct digits) `mod` 256
in (if num < 256 then chr num else '?') : rest in (chr num) : decodeEscapes more
_ -> '\\' : c : rest _ -> '\\' : c : rest
where where
rest = decodeEscapes cs rest = decodeEscapes cs
parseOct = f 0 parseOct = f 0
where where
f n "" = n f n "" = n
f n (c:rest) = f (n * 8 + digitToInt c) rest f n (c:rest) = f (n * 8 + digitToInt c) rest
spanMax f n list =
let (first, second) = span f list
(prefix, suffix) = splitAt n first
in
(prefix, suffix ++ second)
decodeEscapes (c:cs) = c : decodeEscapes cs decodeEscapes (c:cs) = c : decodeEscapes cs
decodeEscapes [] = [] decodeEscapes [] = []
-- Is this token a string literal? -- Is this token a string literal?
isLiteral t = isJust $ getLiteralString t isLiteral t = isJust $ getLiteralString t
-- Escape user data for messages. -- Escape user data for messages.
-- Messages generally avoid repeating user data, but sometimes it's helpful. -- Messages generally avoid repeating user data, but sometimes it's helpful.
e4m = escapeForMessage e4m = escapeForMessage
escapeForMessage :: String -> String escapeForMessage :: String -> String
skipping to change at line 761 skipping to change at line 782
"sh" -> "ash" -- busybox sh is ash "sh" -> "ash" -- busybox sh is ash
x -> x x -> x
(first:args) | basename first == "env" -> (first:args) | basename first == "env" ->
fromEnvArgs args fromEnvArgs args
(first:_) -> basename first (first:_) -> basename first
fromEnvArgs args = fromMaybe "" $ find (notElem '=') $ skipFlags args fromEnvArgs args = fromMaybe "" $ find (notElem '=') $ skipFlags args
basename s = reverse . takeWhile (/= '/') . reverse $ s basename s = reverse . takeWhile (/= '/') . reverse $ s
skipFlags = dropWhile ("-" `isPrefixOf`) 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
getEnableDirectives root =
case root of
T_Annotation _ list _ -> [s | EnableComment s <- list]
_ -> []
return [] return []
runTests = $quickCheckAll runTests = $quickCheckAll
 End of changes. 7 change blocks. 
8 lines changed or deleted 159 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)