Allow escaping ( with quotes in [ .. ] (#925)
This commit is contained in:
parent
ce950edbfd
commit
50c8172de4
|
@ -440,19 +440,9 @@ readConditionContents single =
|
||||||
|
|
||||||
getOp = do
|
getOp = do
|
||||||
id <- getNextId
|
id <- getNextId
|
||||||
op <- anyQuotedOp <|> anyEscapedOp <|> anyOp
|
op <- readRegularOrEscaped anyOp
|
||||||
return $ TC_Binary id typ op
|
return $ TC_Binary id typ op
|
||||||
|
|
||||||
-- hacks to read quoted operators without having to read a shell word
|
|
||||||
anyEscapedOp = try $ do
|
|
||||||
char '\\'
|
|
||||||
escaped <$> anyOp
|
|
||||||
anyQuotedOp = try $ do
|
|
||||||
c <- oneOf "'\""
|
|
||||||
s <- anyOp
|
|
||||||
char c
|
|
||||||
return $ escaped s
|
|
||||||
|
|
||||||
anyOp = flagOp <|> flaglessOp <|> fail
|
anyOp = flagOp <|> flaglessOp <|> fail
|
||||||
"Expected comparison operator (don't wrap commands in []/[[]])"
|
"Expected comparison operator (don't wrap commands in []/[[]])"
|
||||||
flagOp = try $ do
|
flagOp = try $ do
|
||||||
|
@ -461,7 +451,22 @@ readConditionContents single =
|
||||||
return s
|
return s
|
||||||
flaglessOp =
|
flaglessOp =
|
||||||
choice $ map (try . string) flaglessOps
|
choice $ map (try . string) flaglessOps
|
||||||
escaped s = if any (`elem` s) "<>" then '\\':s else s
|
|
||||||
|
-- hacks to read quoted operators without having to read a shell word
|
||||||
|
readEscaped p = try $ withEscape <|> withQuotes
|
||||||
|
where
|
||||||
|
withEscape = do
|
||||||
|
char '\\'
|
||||||
|
escaped <$> p
|
||||||
|
withQuotes = do
|
||||||
|
c <- oneOf "'\""
|
||||||
|
s <- p
|
||||||
|
char c
|
||||||
|
return $ escaped s
|
||||||
|
escaped s = if any (`elem` s) "<>()" then '\\':s else s
|
||||||
|
|
||||||
|
readRegularOrEscaped p = readEscaped p <|> p
|
||||||
|
|
||||||
|
|
||||||
guardArithmetic = do
|
guardArithmetic = do
|
||||||
try . lookAhead $ disregard (oneOf "+*/%") <|> disregard (string "- ")
|
try . lookAhead $ disregard (oneOf "+*/%") <|> disregard (string "- ")
|
||||||
|
@ -562,27 +567,28 @@ readConditionContents single =
|
||||||
readCondGroup = do
|
readCondGroup = do
|
||||||
id <- getNextId
|
id <- getNextId
|
||||||
pos <- getPosition
|
pos <- getPosition
|
||||||
lparen <- try $ string "(" <|> string "\\("
|
lparen <- try $ readRegularOrEscaped (string "(")
|
||||||
when (single && lparen == "(") $
|
when (single && lparen == "(") $
|
||||||
parseProblemAt pos ErrorC 1028 "In [..] you have to escape (). Use [[..]] instead."
|
singleWarning pos
|
||||||
when (not single && lparen == "\\(") $
|
when (not single && lparen == "\\(") $
|
||||||
parseProblemAt pos ErrorC 1029 "In [[..]] you shouldn't escape ()."
|
doubleWarning pos
|
||||||
condSpacing single
|
condSpacing single
|
||||||
x <- readCondContents
|
x <- readCondContents
|
||||||
cpos <- getPosition
|
cpos <- getPosition
|
||||||
rparen <- string ")" <|> string "\\)"
|
rparen <- readRegularOrEscaped (string ")")
|
||||||
condSpacing single
|
condSpacing single
|
||||||
when (single && rparen == ")") $
|
when (single && rparen == ")") $
|
||||||
parseProblemAt cpos ErrorC 1030 "In [..] you have to escape (). Use [[..]] instead."
|
singleWarning cpos
|
||||||
when (not single && rparen == "\\)") $
|
when (not single && rparen == "\\)") $
|
||||||
parseProblemAt cpos ErrorC 1031 "In [[..]] you shouldn't escape ()."
|
doubleWarning cpos
|
||||||
when (isEscaped lparen `xor` isEscaped rparen) $
|
|
||||||
parseProblemAt pos ErrorC 1032 "Did you just escape one half of () but not the other?"
|
|
||||||
return $ TC_Group id typ x
|
return $ TC_Group id typ x
|
||||||
|
|
||||||
where
|
where
|
||||||
isEscaped ('\\':_) = True
|
singleWarning pos =
|
||||||
isEscaped _ = False
|
parseProblemAt pos ErrorC 1028 "In [..] you have to escape \\( \\) or preferably combine [..] expressions."
|
||||||
xor x y = x && not y || not x && y
|
doubleWarning pos =
|
||||||
|
parseProblemAt pos ErrorC 1029 "In [[..]] you shouldn't escape ( or )."
|
||||||
|
|
||||||
|
|
||||||
-- Currently a bit of a hack since parsing rules are obscure
|
-- Currently a bit of a hack since parsing rules are obscure
|
||||||
regexOperatorAhead = lookAhead (do
|
regexOperatorAhead = lookAhead (do
|
||||||
|
@ -849,6 +855,7 @@ prop_readCondition15= isOk readCondition "[ foo \">=\" bar ]"
|
||||||
prop_readCondition16= isOk readCondition "[ foo \\< bar ]"
|
prop_readCondition16= isOk readCondition "[ foo \\< bar ]"
|
||||||
prop_readCondition17= isOk readCondition "[[ ${file::1} = [-.\\|/\\\\] ]]"
|
prop_readCondition17= isOk readCondition "[[ ${file::1} = [-.\\|/\\\\] ]]"
|
||||||
prop_readCondition18= isOk readCondition "[ ]"
|
prop_readCondition18= isOk readCondition "[ ]"
|
||||||
|
prop_readCondition19= isOk readCondition "[ '(' x \")\" ]"
|
||||||
readCondition = called "test expression" $ do
|
readCondition = called "test expression" $ do
|
||||||
opos <- getPosition
|
opos <- getPosition
|
||||||
id <- getNextId
|
id <- getNextId
|
||||||
|
|
Loading…
Reference in New Issue