module Parse
( parseShellTestFile
)
where
import Text.Parsec
import Text.Parsec.String
import Import
import Types
import Utils hiding (dbg, ptrace)
import qualified Utils
import Preprocessor
import System.IO hiding (stdin)
parseFromFileWithPreprocessor :: (Parser [ShellTest]) -> PreProcessor -> FilePath -> IO (Either ParseError [ShellTest])
parseFromFileWithPreprocessor p preproc fname =
do
h <- openFile fname ReadMode
hSetNewlineMode h universalNewlineMode
input <- hGetContents h
let processed = preprocess preproc input
case processed of Right text -> return (runParser p () fname text)
(Left err) -> return (Left err) -- To make haskell happy.
-- parseFromFile
-- | Parse this shell test file, optionally logging debug output.
parseShellTestFile :: Bool -> PreProcessor -> FilePath -> IO (Either ParseError [ShellTest])
parseShellTestFile debug preProcessor f = do
p <- parseFromFileWithPreprocessor shelltestfile preProcessor f
case p of
Right ts -> do
let ts' | length ts > 1 = [t{testname=testname t++":"++show n} | (n,t) <- zip ([1..]::[Int]) ts]
| otherwise = ts
when (debug) $ do
printf "parsed %s:\n" f
mapM_ (putStrLn.(' ':).ppShow) ts'
return $ Right ts'
Left _ -> do
when (debug) $ printf "failed to parse any tests in %s\n" f
return p
-- parsers
-- show lots of parsing debug output if enabled.
-- NB not connected to the --debug-parse flag
showParserDebugOutput = debugLevel >= 2
ptrace_ s | showParserDebugOutput = Utils.ptrace s
| otherwise = return ()
ptrace s a | showParserDebugOutput = Utils.ptrace $ s ++ ": " ++ show a
| otherwise = return ()
shelltestfile :: Parser [ShellTest]
shelltestfile = do
ptrace_ "shelltestfile 0"
ts <- try (do first <- try (format2testgroup False)
rest <- many $ try (format2testgroup True)
return $ concat $ first : rest
)
<|>
(do first <- try (format3testgroup False)
rest <- many $ try (format3testgroup True)
return $ concat $ first : rest
)
<|>
(many $ try format1test)
ptrace_ "shelltestfile 1"
skipMany whitespaceorcommentline
ptrace_ "shelltestfile 2"
eof
ptrace "shelltestfile ." ts
return ts
----------------------------------------------------------------------
-- format 1 (shelltestrunner 1.x)
-- each test specifies its input; missing test parts are not checked
format1test = do
ptrace_ " format1test 0"
skipMany whitespaceorcommentline
ptrace_ " format1test 1"
c <- command1 <?> "command line"
ptrace " format1test c" c
i <- optionMaybe input1 <?> "input"
ptrace " format1test i" i
o <- optionMaybe expectedoutput1 <?> "expected output"
ptrace " format1test o" o
e <- optionMaybe expectederror1 <?> "expected error output"
ptrace " format1test e" e
x <- expectedexitcode1 <?> "expected exit status"
ptrace " format1test x" x
when (null (show c) && (isNothing i) && (null $ catMaybes [o,e]) && null (show x)) $ fail ""
f <- sourceName . statePos <$> getParserState
let t = ShellTest{testname=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x}
ptrace " format1test ." t
return t
command1 :: Parser TestCommand
command1 = fixedcommand <|> replaceablecommand
input1 :: Parser String
input1 = try $ string "<<<" >> whitespaceorcommentline >> unlines <$> (line `manyTill` (lookAhead (try delimiter)))
expectedoutput1 :: Parser Matcher
expectedoutput1 = (try $ do
string ">>>"
whitespace
choice [regexmatcher, negativeregexmatcher, whitespaceorcommentlineoreof >> linesmatcher1]
) <?> "expected output"
expectederror1 :: Parser Matcher
expectederror1 = (try $ do
string ">>>2"
whitespace
choice [regexmatcher, negativeregexmatcher, (whitespaceorcommentlineoreof >> linesmatcher1)]
) <?> "expected error output"
expectedexitcode1 :: Parser Matcher
expectedexitcode1 = (try $ do
string ">>>="
whitespace
fromMaybe anyMatcher <$> (optionMaybe $ choice [regexmatcher, try negativeregexmatcher, numericmatcher, negativenumericmatcher])
) <?> "expected exit status"
----------------------------------------------------------------------
-- format 2
-- input first, then tests; missing test parts are implicitly checked
-- A format 2 test group, optionally with the initial <<< delimiter
-- being optional.
format2testgroup :: Bool -> Parser [ShellTest]
format2testgroup inputRequiresDelimiter = do
ptrace " format2testgroup 0" inputRequiresDelimiter
skipMany whitespaceorcommentline
ptrace_ " format2testgroup 1"
let startdelims | inputRequiresDelimiter = ["<<<"]
| otherwise = ["<<<", ""]
enddelims = ["$$$","<<<"]
i <- optionMaybe (linesBetween startdelims enddelims) <?> "input"
ptrace " format2testgroup i" i
ts <- many1 $ try (format2test i)
ptrace " format2testgroup ." ts
return ts
format2test :: Maybe String -> Parser ShellTest
format2test i = do
ptrace_ " format2test 0"
skipMany whitespaceorcommentline
ptrace_ " format2test 1"
c <- command2 <?> "command line"
ptrace " format2test c" c
nullstdout <- nullLinesMatcher . sourceLine <$> getPosition
o <- maybe (Just nullstdout) Just <$> optionMaybe expectedoutput2 <?> "expected output"
ptrace " format2test o" o
nullstderr <- nullLinesMatcher . sourceLine <$> getPosition
e <- maybe (Just $ nullstderr) Just <$> optionMaybe expectederror2 <?> "expected error output"
ptrace " format2test e" e
x <- fromMaybe nullStatusMatcher <$> optionMaybe expectedexitcode2 <?> "expected exit status"
ptrace " format2test x" x
when (null (show c) && (isNothing i) && (null $ catMaybes [o,e]) && null (show x)) $ fail ""
f <- sourceName . statePos <$> getParserState
let t = ShellTest{testname=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x}
ptrace " format2test ." t
return t
nullLinesMatcher n = Lines n ""
nullStatusMatcher = Numeric "0"
anyMatcher = PositiveRegex ""
command2 :: Parser TestCommand
command2 = string "$$$" >> optional (char ' ') >> (fixedcommand <|> replaceablecommand)
-- In format 2, >>> is used only with /REGEX/, also don't consume the
-- whitespace/comments immediately preceding a following test.
expectedoutput2 :: Parser Matcher
expectedoutput2 = (try $ do
try (string ">>>" >> whitespace >> (regexmatcher <|> negativeregexmatcher))
<|> (optional (string ">>>" >> whitespaceline) >> linesmatcher2 <?> "expected output")
)
-- Don't consume the whitespace/comments immediately preceding a
-- following test.
expectederror2 :: Parser Matcher
expectederror2 = (try $ do
ptrace_ " expectederror2 0"
string ">>>2" >> whitespace
ptrace_ " expectederror2 1"
m <- (regexmatcher <|> negativeregexmatcher)
<|>
(newline >> linesmatcher2 <?> "expected error output")
ptrace " expectederror2 ." m
return m
)
expectedexitcode2 :: Parser Matcher
expectedexitcode2 = expectedexitcode1
-- The format 2 lines matcher consumes lines until one of these:
-- 1. another section delimiter in this test (>>>, >>>2, >>>=)
-- 2. the next test's start delimiter (<<<, $$$), or the start of blank/comment lines preceding it
-- 3. end of file, or the start of blank/comment lines preceding it
linesmatcher2 :: Parser Matcher
linesmatcher2 = do
ptrace_ " linesmatcher2 0"
ln <- sourceLine <$> getPosition
ls <- unlines <$>
line `manyTill` lookAhead (choice' [delimiterNotNewTest
,many whitespaceorcommentline >> delimiterNewTest
,many whitespaceorcommentline >> eofasstr])
<?> "lines of output"
ptrace " linesmatcher2 ." ls
return $ Lines ln ls
delimiterNewTest = do
-- ptrace_ " delimiterNewTest 0"
choice [string "$$$", string "<<<"]
delimiterNotNewTest = do
-- ptrace_ " delimiterNotNewTest 0"
choice [try (string ">>>2"), try (string ">>>="), string ">>>"]
----------------------------------------------------------------------
-- format 3
-- Like format 2 but with short delimiters.
-- XXX duplication
format3testgroup :: Bool -> Parser [ShellTest]
format3testgroup inputRequiresDelimiter = do
ptrace " format3testgroup 0" inputRequiresDelimiter
skipMany whitespaceorcommentline
ptrace_ " format3testgroup 1"
let startdelims | inputRequiresDelimiter = ["<"]
| otherwise = ["<", ""]
enddelims = ["$","<"]
i <- optionMaybe (linesBetween startdelims enddelims) <?> "input"
ptrace " format3testgroup i" i
ts <- many1 $ try (format3test i)
ptrace " format3testgroup ." ts
return ts
format3test :: Maybe String -> Parser ShellTest
format3test i = do
ptrace_ " format3test 0"
skipMany whitespaceorcommentline
ptrace_ " format3test 1"
c <- command3 <?> "command line"
ptrace " format3test c" c
nullstdout <- nullLinesMatcher . sourceLine <$> getPosition
o <- maybe (Just nullstdout) Just <$> optionMaybe expectedoutput3 <?> "expected output"
ptrace " format3test o" o
nullstderr <- nullLinesMatcher . sourceLine <$> getPosition
e <- maybe (Just $ nullstderr) Just <$> optionMaybe expectederror3 <?> "expected error output"
ptrace " format3test e" e
x <- fromMaybe nullStatusMatcher <$> optionMaybe expectedexitcode3 <?> "expected exit status"
ptrace " format3test x" x
when (null (show c) && (isNothing i) && (null $ catMaybes [o,e]) && null (show x)) $ fail ""
f <- sourceName . statePos <$> getParserState
let t = ShellTest{testname=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x}
ptrace " format3test ." t
return t
command3 :: Parser TestCommand
command3 = string "$" >> optional (char ' ') >> (fixedcommand <|> replaceablecommand)
-- In format 3, >>> is used only with /REGEX/, also don't consume the
-- whitespace/comments immediately preceding a following test.
expectedoutput3 :: Parser Matcher
expectedoutput3 = (try $ do
try (string ">" >> whitespace >> (regexmatcher <|> negativeregexmatcher))
<|> (optional (string ">" >> whitespaceline) >> linesmatcher3 <?> "expected output")
)
-- Don't consume the whitespace/comments immediately preceding a
-- following test.
expectederror3 :: Parser Matcher
expectederror3 = (try $ do
ptrace_ " expectederror3 0"
string ">2" >> whitespace
ptrace_ " expectederror3 1"
m <- (regexmatcher <|> negativeregexmatcher)
<|>
(newline >> linesmatcher3 <?> "expected error output")
ptrace " expectederror3 ." m
return m
)
expectedexitcode3 :: Parser Matcher
expectedexitcode3 = (try $ do
string ">="
whitespace
fromMaybe anyMatcher <$> (optionMaybe $ choice [regexmatcher, try negativeregexmatcher, numericmatcher, negativenumericmatcher])
) <?> "expected exit status"
-- The format 3 lines matcher consumes lines until one of these:
-- 1. another section delimiter in this test (>, >2, >=)
-- 2. the next test's start delimiter (<, $), or the start of blank/comment lines preceding it
-- 3. end of file, or the start of blank/comment lines preceding it
linesmatcher3 :: Parser Matcher
linesmatcher3 = do
ptrace_ " linesmatcher3 0"
ln <- sourceLine <$> getPosition
ls <- unlines <$>
line `manyTill` lookAhead (choice' [delimiterNotNewTest3
,many whitespaceorcommentline >> delimiterNewTest3
,many whitespaceorcommentline >> eofasstr])
<?> "lines of output"
ptrace " linesmatcher3 ." ls
return $ Lines ln ls
delimiterNewTest3 = do
-- ptrace_ " delimiterNewTest 0"
choice [string "$", string "<"]
delimiterNotNewTest3 = do
-- ptrace_ " delimiterNotNewTest 0"
choice [try (string ">2"), try (string ">="), string ">"]
----------------------------------------------------------------------
-- common
linesBetween :: [String] -> [String] -> Parser String
linesBetween startdelims enddelims = do
let delimp "" = string ""
delimp s = string s <* whitespace <* newline
Utils.choice' $ map delimp startdelims
let end = choice $ (map (try . string) enddelims) ++ [eofasstr]
unlines <$> line `manyTill` lookAhead end
fixedcommand,replaceablecommand :: Parser TestCommand
fixedcommand = many1 whitespacechar >> line >>= return . FixedCommand
replaceablecommand = line >>= return . ReplaceableCommand
regexmatcher :: Parser Matcher
regexmatcher = (do
char '/'
r <- (try escapedslash <|> noneOf "/") `manyTill` (char '/')
whitespaceorcommentlineoreof
return $ PositiveRegex r) <?> "regex pattern"
escapedslash :: Parser Char
escapedslash = char '\\' >> char '/'
negativeregexmatcher :: Parser Matcher
negativeregexmatcher = (do
char '!'
PositiveRegex r <- regexmatcher
return $ NegativeRegex r) <?> "negative regex pattern"
numericmatcher :: Parser Matcher
numericmatcher = (do
s <- many1 $ oneOf "0123456789"
whitespaceorcommentlineoreof
return $ Numeric s
) <?> "number match"
negativenumericmatcher :: Parser Matcher
negativenumericmatcher = (do
char '!'
Numeric s <- numericmatcher
return $ NegativeNumeric s
) <?> "negative number match"
linesmatcher1 :: Parser Matcher
linesmatcher1 = do
ln <- sourceLine <$> getPosition
(Lines ln . unlines <$>) (line `manyTill` (lookAhead delimiter)) <?> "lines of output"
delimiter = choice [string "$$$", string "<<<", try (string ">>>2"), try (string ">>>="), string ">>>", eofasstr]
-- longdelims = ["<<<", "$$$", ">>>2", ">>>=", ">>>"]
-- shortdelims = ["<", "$", ">2", ">=", ">"]
-- newlineoreof, whitespacechar :: Parser Char
-- line,lineoreof,whitespace,whitespaceline,commentline,whitespaceorcommentline,whitespaceorcommentlineoreof,delimiter,input :: Parser String
-- lineoreof = (anyChar `manyTill` newlineoreof)
-- XXX shouldn't it be:
lineoreof = (noneOf "\n" `manyTill` newlineoreof)
newlineoreof = newline <|> (eof >> return '\n') <?> "newline or end of file"
line = (anyChar `manyTill` newline) <?> "rest of line"
whitespacechar = oneOf " \t"
whitespace = many whitespacechar
whitespaceline = try (newline >> return "") <|> try (whitespacechar >> whitespacechar `manyTill` newlineoreof)
commentline = try (whitespace >> char '#' >> lineoreof) <?> "comments"
whitespaceorcommentline = commentline <|> whitespaceline
whitespaceorcommentlineoreof = choice [eofasstr, commentline, whitespaceline]
eofasstr = eof >> return ""