Merge ac892b7d06 into 6a71ff6f46

ShellCheck/Checker.hs

@@ -29,6 +29,7 @@ import Data.Functor
 import Data.List
 import Data.Maybe
 import Data.Ord
+import Control.Applicative
 import Control.Monad.Identity
 import qualified Data.Map as Map
 import qualified System.IO
@@ -37,11 +38,14 @@ import Control.Monad
 
 import Test.QuickCheck.All
 
-tokenToPosition map (TokenComment id c) = fromMaybe fail $ do
-    position <- Map.lookup id map
-    return $ PositionedComment position position c
+tokenToPosition startMap endMap (TokenComment id c) = fromMaybe fail $ do
+    position <- maybePosition
+    endPosition <- maybeEndPosition <|> maybePosition
+    return $ PositionedComment position endPosition c
   where
     fail = error "Internal shellcheck error: id doesn't exist. Please report!"
+    maybeEndPosition = Map.lookup id endMap
+    maybePosition = Map.lookup id startMap
 
 checkScript :: Monad m => SystemInterface m -> CheckSpec -> m CheckResult
 checkScript sys spec = do
@@ -61,7 +65,7 @@ checkScript sys spec = do
                 fromMaybe [] $
                     (arComments . analyzeScript . analysisSpec)
                         <$> prRoot result
-        let translator = tokenToPosition (prTokenPositions result)
+        let translator = tokenToPosition (prTokenPositions result) (prTokenEndPositions result)
         return . nub . sortMessages . filter shouldInclude $
             (parseMessages ++ map translator analysisMessages)
 

ShellCheck/Interface.hs

@@ -58,6 +58,7 @@ data ParseSpec = ParseSpec {
 data ParseResult = ParseResult {
     prComments :: [PositionedComment],
     prTokenPositions :: Map.Map Id Position,
+    prTokenEndPositions :: Map.Map Id Position,
     prRoot :: Maybe Token
 } deriving (Show, Eq)
 

ShellCheck/Parser.hs

@@ -133,6 +133,38 @@ almostSpace =
         char c
         return ' '
 
+withNextId :: Monad m => ParsecT s UserState (SCBase m) (Id -> b) -> ParsecT s UserState (SCBase m) b
+withNextId p = do
+    start <- getPosition
+    id <- createId
+    setStartPos id start
+    fn <- p
+    let t = fn id
+    end <- getPosition
+    setEndPos id end
+    return t
+  where
+    createId = do
+        state <- getState
+        let id = incId (lastId state)
+        putState $ state {
+            lastId = id
+        }
+        return id
+      where incId (Id n) = Id $ n+1
+    setStartPos id sourcepos = do
+      state <- getState
+      let newMap = Map.insert id sourcepos (positionMap state)
+      putState $ state {
+          positionMap = newMap
+      }
+    setEndPos id sourcepos = do
+      state <- getState
+      let newMap = Map.insert id sourcepos (positionEndMap state)
+      putState $ state {
+          positionEndMap = newMap
+      }
+
 --------- Message/position annotation on top of user state
 data Note = Note Id Severity Code String deriving (Show, Eq)
 data ParseNote = ParseNote SourcePos SourcePos Severity Code String deriving (Show, Eq)
@@ -150,6 +182,7 @@ data HereDocContext =
 data UserState = UserState {
     lastId :: Id,
     positionMap :: Map.Map Id SourcePos,
+    positionEndMap :: Map.Map Id SourcePos,
     parseNotes :: [ParseNote],
     hereDocMap :: Map.Map Id [Token],
     pendingHereDocs :: [HereDocContext]
@@ -157,6 +190,7 @@ data UserState = UserState {
 initialUserState = UserState {
     lastId = Id $ -1,
     positionMap = Map.empty,
+    positionEndMap = Map.empty,
     parseNotes = [],
     hereDocMap = Map.empty,
     pendingHereDocs = []
@@ -170,6 +204,7 @@ noteToParseNote map (Note id severity code message) =
 
 getLastId = lastId <$> getState
 
+-- Deprecated by withNextId
 getNextIdAt sourcepos = do
     state <- getState
     let newId = incId (lastId state)
@@ -181,6 +216,7 @@ getNextIdAt sourcepos = do
     return newId
   where incId (Id n) = Id $ n+1
 
+-- Deprecated by withNextId
 getNextId = do
     pos <- getPosition
     getNextIdAt pos
@@ -1131,8 +1167,7 @@ prop_readDoubleQuoted4 = isWarning readSimpleCommand "\"foo\nbar\"foo"
 prop_readDoubleQuoted5 = isOk readSimpleCommand "lol \"foo\nbar\" etc"
 prop_readDoubleQuoted6 = isOk readSimpleCommand "echo \"${ ls; }\""
 prop_readDoubleQuoted7 = isOk readSimpleCommand "echo \"${ ls;}bar\""
-readDoubleQuoted = called "double quoted string" $ do
-    id <- getNextId
+readDoubleQuoted = called "double quoted string" $ withNextId $ do
     startPos <- getPosition
     doubleQuote
     x <- many doubleQuotedPart
@@ -1142,7 +1177,7 @@ readDoubleQuoted = called "double quoted string" $ do
         try . lookAhead $ suspectCharAfterQuotes <|> oneOf "$\""
         when (any hasLineFeed x && not (startsWithLineFeed x)) $
             suggestForgotClosingQuote startPos endPos "double quoted string"
-    return $ T_DoubleQuoted id x
+    return $ \id -> T_DoubleQuoted id x
   where
     startsWithLineFeed (T_Literal _ ('\n':_):_) = True
     startsWithLineFeed _ = False
@@ -1463,16 +1498,18 @@ prop_readDollarVariable2 = isOk (readDollarVariable >> anyChar) "$?!"
 prop_readDollarVariable3 = isWarning (readDollarVariable >> anyChar) "$10"
 prop_readDollarVariable4 = isWarning (readDollarVariable >> string "[@]") "$arr[@]"
 
-readDollarVariable = do
-    id <- getNextId
+readDollarVariable :: Monad m => ParsecT String UserState (SCBase m) Token
+readDollarVariable = withNextId $ do
     pos <- getPosition
 
-    let singleCharred p = do
+    let
+      singleCharred p = do
         n <- p
         value <- wrap [n]
-        return (T_DollarBraced id value)
+        return $ \id -> (T_DollarBraced id value)
 
-    let positional = do
+    let
+      positional = do
         value <- singleCharred digit
         return value `attempting` do
             lookAhead digit
@@ -1483,17 +1520,15 @@ readDollarVariable = do
     let regular = do
         name <- readVariableName
         value <- wrap name
-        return (T_DollarBraced id value) `attempting` do
+        return (\id -> (T_DollarBraced id value)) `attempting` do
             lookAhead $ void (string "[@]") <|> void (string "[*]") <|> void readArrayIndex
             parseNoteAt pos ErrorC 1087 "Braces are required when expanding arrays, as in ${array[idx]}."
 
     try $ char '$' >> (positional <|> special <|> regular)
 
   where
-    wrap s = do
-        x <- getNextId
-        y <- getNextId
-        return $ T_NormalWord x [T_Literal y s]
+    wrap s = withNextId $ withNextId $ do
+        return $ \x y -> T_NormalWord x [T_Literal y s]
 
 readVariableName = do
     f <- variableStart
@@ -2677,6 +2712,7 @@ parseShell sys name contents = do
             return ParseResult {
                 prComments = map toPositionedComment $ nub $ parseNotes userstate ++ parseProblems state,
                 prTokenPositions = Map.map posToPos (positionMap userstate),
+                prTokenEndPositions = Map.map posToPos (positionEndMap userstate),
                 prRoot = Just $
                     reattachHereDocs script (hereDocMap userstate)
             }
@@ -2688,6 +2724,7 @@ parseShell sys name contents = do
                         ++ [makeErrorFor err]
                         ++ parseProblems state,
                 prTokenPositions = Map.empty,
+                prTokenEndPositions = Map.empty,
                 prRoot = Nothing
             }
   where