Add support for coproc
This commit is contained in:
parent
895d83afc5
commit
a485482979
|
@ -123,6 +123,7 @@ data Token =
|
||||||
| T_WhileExpression Id [Token] [Token]
|
| T_WhileExpression Id [Token] [Token]
|
||||||
| T_Annotation Id [Annotation] Token
|
| T_Annotation Id [Annotation] Token
|
||||||
| T_Pipe Id String
|
| T_Pipe Id String
|
||||||
|
| T_CoProc Id (Maybe String) Token
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
data Annotation = DisableComment Integer deriving (Show, Eq)
|
data Annotation = DisableComment Integer deriving (Show, Eq)
|
||||||
|
@ -248,6 +249,7 @@ analyze f g i =
|
||||||
delve (TA_Expansion id t) = dl t $ TA_Expansion id
|
delve (TA_Expansion id t) = dl t $ TA_Expansion id
|
||||||
delve (TA_Index id t) = d1 t $ TA_Index id
|
delve (TA_Index id t) = d1 t $ TA_Index id
|
||||||
delve (T_Annotation id anns t) = d1 t $ T_Annotation id anns
|
delve (T_Annotation id anns t) = d1 t $ T_Annotation id anns
|
||||||
|
delve (T_CoProc id var body) = d1 body $ T_CoProc id var
|
||||||
delve t = return t
|
delve t = return t
|
||||||
|
|
||||||
getId t = case t of
|
getId t = case t of
|
||||||
|
@ -341,6 +343,7 @@ getId t = case t of
|
||||||
T_DollarBracket id _ -> id
|
T_DollarBracket id _ -> id
|
||||||
T_Annotation id _ _ -> id
|
T_Annotation id _ _ -> id
|
||||||
T_Pipe id _ -> id
|
T_Pipe id _ -> id
|
||||||
|
T_CoProc id _ _ -> id
|
||||||
|
|
||||||
blank :: Monad m => Token -> m ()
|
blank :: Monad m => Token -> m ()
|
||||||
blank = const $ return ()
|
blank = const $ return ()
|
||||||
|
|
|
@ -669,6 +669,8 @@ checkBashisms _ = bashism
|
||||||
warnMsg id "arrays are"
|
warnMsg id "arrays are"
|
||||||
bashism (T_IoFile id _ t) | isGlob t =
|
bashism (T_IoFile id _ t) | isGlob t =
|
||||||
warnMsg id "redirecting to/from globs is"
|
warnMsg id "redirecting to/from globs is"
|
||||||
|
bashism (T_CoProc id _ _) =
|
||||||
|
warnMsg id "coproc is"
|
||||||
|
|
||||||
bashism _ = return ()
|
bashism _ = return ()
|
||||||
|
|
||||||
|
@ -818,7 +820,10 @@ checkRedirectToSame params s@(T_Pipeline _ _ list) =
|
||||||
addNote $ note newId
|
addNote $ note newId
|
||||||
addNote $ note exceptId
|
addNote $ note exceptId
|
||||||
checkOccurrences _ _ = return ()
|
checkOccurrences _ _ = return ()
|
||||||
getAllRedirs = concatMap (\(T_Redirecting _ ls _) -> concatMap getRedirs ls)
|
getAllRedirs = concatMap (\t ->
|
||||||
|
case t of
|
||||||
|
T_Redirecting _ ls _ -> concatMap getRedirs ls
|
||||||
|
_ -> [])
|
||||||
getRedirs (T_FdRedirect _ _ (T_IoFile _ op file)) =
|
getRedirs (T_FdRedirect _ _ (T_IoFile _ op file)) =
|
||||||
case op of T_Greater _ -> [file]
|
case op of T_Greater _ -> [file]
|
||||||
T_Less _ -> [file]
|
T_Less _ -> [file]
|
||||||
|
@ -1969,6 +1974,7 @@ leadType shell parents t =
|
||||||
T_Backticked _ _ -> SubshellScope "`..` expansion"
|
T_Backticked _ _ -> SubshellScope "`..` expansion"
|
||||||
T_Backgrounded _ _ -> SubshellScope "backgrounding &"
|
T_Backgrounded _ _ -> SubshellScope "backgrounding &"
|
||||||
T_Subshell _ _ -> SubshellScope "(..) group"
|
T_Subshell _ _ -> SubshellScope "(..) group"
|
||||||
|
T_CoProc _ _ _ -> SubshellScope "coproc"
|
||||||
T_Redirecting {} ->
|
T_Redirecting {} ->
|
||||||
if fromMaybe False causesSubshell
|
if fromMaybe False causesSubshell
|
||||||
then SubshellScope "pipeline"
|
then SubshellScope "pipeline"
|
||||||
|
|
|
@ -1459,7 +1459,11 @@ readPipe = do
|
||||||
spacing
|
spacing
|
||||||
return $ T_Pipe id ('|':qualifier)
|
return $ T_Pipe id ('|':qualifier)
|
||||||
|
|
||||||
readCommand = readCompoundCommand <|> readSimpleCommand
|
readCommand = choice [
|
||||||
|
readCompoundCommand,
|
||||||
|
readCoProc,
|
||||||
|
readSimpleCommand
|
||||||
|
]
|
||||||
|
|
||||||
readCmdName = do
|
readCmdName = do
|
||||||
f <- readNormalWord
|
f <- readNormalWord
|
||||||
|
@ -1797,6 +1801,26 @@ readFunctionDefinition = called "function" $ do
|
||||||
|
|
||||||
readFunctionName = many functionChars
|
readFunctionName = many functionChars
|
||||||
|
|
||||||
|
prop_readCoProc1 = isOk readCoProc "coproc foo { echo bar; }"
|
||||||
|
prop_readCoProc2 = isOk readCoProc "coproc { echo bar; }"
|
||||||
|
prop_readCoProc3 = isOk readCoProc "coproc echo bar"
|
||||||
|
readCoProc = called "coproc" $ do
|
||||||
|
id <- getNextId
|
||||||
|
try $ do
|
||||||
|
string "coproc"
|
||||||
|
whitespace
|
||||||
|
choice [ try $ readCompoundCoProc id, readSimpleCoProc id ]
|
||||||
|
where
|
||||||
|
readCompoundCoProc id = do
|
||||||
|
var <- optionMaybe $
|
||||||
|
readVariableName `thenSkip` whitespace
|
||||||
|
body <- readCompoundCommand
|
||||||
|
return $ T_CoProc id var body
|
||||||
|
readSimpleCoProc id = do
|
||||||
|
body <- readSimpleCommand
|
||||||
|
return $ T_CoProc id Nothing body
|
||||||
|
|
||||||
|
|
||||||
readPattern = (readNormalWord `thenSkip` spacing) `sepBy1` (char '|' `thenSkip` spacing)
|
readPattern = (readNormalWord `thenSkip` spacing) `sepBy1` (char '|' `thenSkip` spacing)
|
||||||
|
|
||||||
prop_readCompoundCommand = isOk readCompoundCommand "{ echo foo; }>/dev/null"
|
prop_readCompoundCommand = isOk readCompoundCommand "{ echo foo; }>/dev/null"
|
||||||
|
|
Loading…
Reference in New Issue