Split include file expansion out into a separate pass.
The order of initial passes is now: lex -> preprocess -> structure -> expand-include -> parse which means that #IFing out structurally-invalid code (like inline VALOF) now works. This also cleans up the preprocessor code a bit.
This commit is contained in:
Adam Sampson
parent
d7fbd93816
commit
a2a15cab64
|
|
@ -138,6 +138,7 @@ data TokenType =
|
|||
| TokHexLiteral String
|
||||
| TokRealLiteral String
|
||||
| TokPreprocessor String
|
||||
| IncludeFile String -- ^ Include a file
|
||||
| Indent -- ^ Indentation increase
|
||||
| Outdent -- ^ Indentation decrease
|
||||
| EndOfLine -- ^ End of line
|
||||
|
|
|
|||
|
|
@ -18,7 +18,8 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
-}
|
||||
|
||||
-- | Preprocess occam code.
|
||||
module PreprocessOccam (preprocessOccamProgram, preprocessOccamSource, preprocessOccam) where
|
||||
module PreprocessOccam (preprocessOccamProgram, preprocessOccamSource,
|
||||
preprocessOccam, expandIncludes) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.List
|
||||
|
|
@ -69,7 +70,7 @@ preprocessFile m filename
|
|||
toks <- preprocessSource m realFilename s
|
||||
modify (\cs -> cs { csCurrentFile = csCurrentFile origCS })
|
||||
return toks
|
||||
|
||||
|
||||
-- | Preprocesses source directly and returns its tokenised form ready for parsing.
|
||||
preprocessSource :: Meta -> String -> String -> PassM [Token]
|
||||
preprocessSource m realFilename s
|
||||
|
|
@ -77,32 +78,38 @@ preprocessSource m realFilename s
|
|||
veryDebug $ "{{{ lexer tokens"
|
||||
veryDebug $ pshow toks
|
||||
veryDebug $ "}}}"
|
||||
toks' <- structureOccam toks
|
||||
veryDebug $ "{{{ structured tokens"
|
||||
toks' <- preprocessOccam toks
|
||||
veryDebug $ "{{{ preprocessed tokens"
|
||||
veryDebug $ pshow toks'
|
||||
veryDebug $ "}}}"
|
||||
toks'' <- preprocessOccam toks'
|
||||
veryDebug $ "{{{ preprocessed tokens"
|
||||
toks'' <- structureOccam toks'
|
||||
veryDebug $ "{{{ structured tokens"
|
||||
veryDebug $ pshow toks''
|
||||
veryDebug $ "}}}"
|
||||
return toks''
|
||||
expandIncludes toks''
|
||||
|
||||
-- | Expand 'IncludeFile' markers in a token stream.
|
||||
expandIncludes :: [Token] -> PassM [Token]
|
||||
expandIncludes [] = return []
|
||||
expandIncludes ((m, IncludeFile filename) : (_, EndOfLine) : ts)
|
||||
= do contents <- preprocessFile m filename
|
||||
rest <- expandIncludes ts
|
||||
return $ contents ++ rest
|
||||
expandIncludes ((m, IncludeFile _):_) = error "IncludeFile token should be followed by EndOfLine"
|
||||
expandIncludes (t:ts) = expandIncludes ts >>* (t :)
|
||||
|
||||
-- | Preprocess a token stream.
|
||||
preprocessOccam :: [Token] -> PassM [Token]
|
||||
preprocessOccam [] = return []
|
||||
preprocessOccam ((m, TokPreprocessor s):(_, EndOfLine):ts)
|
||||
= do (beforeRest, afterRest) <- handleDirective m (stripPrefix s)
|
||||
rest <- beforeRest ts >>= preprocessOccam
|
||||
return $ afterRest rest
|
||||
preprocessOccam ((m, TokPreprocessor s):ts)
|
||||
= do beforeRest <- handleDirective m (stripPrefix s)
|
||||
beforeRest ts >>= preprocessOccam
|
||||
where
|
||||
stripPrefix :: String -> String
|
||||
stripPrefix (' ':cs) = stripPrefix cs
|
||||
stripPrefix ('\t':cs) = stripPrefix cs
|
||||
stripPrefix ('#':cs) = cs
|
||||
stripPrefix _ = error "bad TokPreprocessor prefix"
|
||||
-- Check the above case didn't miss something.
|
||||
preprocessOccam ((_, TokPreprocessor _):_)
|
||||
= error "bad TokPreprocessor token"
|
||||
preprocessOccam ((_, TokReserved "##") : (m, TokIdentifier var) : ts)
|
||||
= do st <- get
|
||||
case Map.lookup var (csDefinitions st) of
|
||||
|
|
@ -121,10 +128,10 @@ preprocessOccam (t:ts)
|
|||
return $ t : rest
|
||||
|
||||
--{{{ preprocessor directive handlers
|
||||
type DirectiveFunc = Meta -> [String] -> PassM ([Token] -> PassM [Token], [Token] -> [Token])
|
||||
type DirectiveFunc = Meta -> [String] -> PassM ([Token] -> PassM [Token])
|
||||
|
||||
-- | Call the handler for a preprocessor directive.
|
||||
handleDirective :: Meta -> String -> PassM ([Token] -> PassM [Token], [Token] -> [Token])
|
||||
handleDirective :: Meta -> String -> PassM ([Token] -> PassM [Token])
|
||||
handleDirective m s = lookup s directives
|
||||
where
|
||||
-- FIXME: This should really be an error rather than a warning, but
|
||||
|
|
@ -132,7 +139,7 @@ handleDirective m s = lookup s directives
|
|||
-- useful.
|
||||
lookup s []
|
||||
= do addWarning m "Unknown preprocessor directive ignored"
|
||||
return (return, id)
|
||||
return return
|
||||
lookup s ((re, func):ds)
|
||||
= case matchRegex re s of
|
||||
Just fields -> func m fields
|
||||
|
|
@ -155,7 +162,7 @@ directives =
|
|||
|
||||
-- | Handle a directive that can be ignored.
|
||||
handleIgnorable :: DirectiveFunc
|
||||
handleIgnorable _ _ = return (return, id)
|
||||
handleIgnorable _ _ = return return
|
||||
|
||||
-- | Handle a directive that should have been removed as part of handling an
|
||||
-- earlier directive.
|
||||
|
|
@ -165,8 +172,7 @@ handleUnmatched m _ = dieP m "Unmatched #ELSE/#ENDIF"
|
|||
-- | Handle the @#INCLUDE@ directive.
|
||||
handleInclude :: DirectiveFunc
|
||||
handleInclude m [incName]
|
||||
= do toks <- preprocessFile m incName
|
||||
return (return, \ts -> toks ++ ts)
|
||||
= return (\ts -> return $ (m, IncludeFile incName) : ts)
|
||||
|
||||
-- | Handle the @#USE@ directive.
|
||||
-- This is a bit of a hack at the moment, since it just includes the file
|
||||
|
|
@ -177,7 +183,7 @@ handleUse m [modName]
|
|||
cs <- get
|
||||
put $ cs { csUsedFiles = Set.insert incName (csUsedFiles cs) }
|
||||
if Set.member incName (csUsedFiles cs)
|
||||
then return (return, id)
|
||||
then return return
|
||||
else handleInclude m [incName]
|
||||
where
|
||||
-- | If a module name doesn't already have a suffix, add one.
|
||||
|
|
@ -195,41 +201,41 @@ handleDefine m [definition]
|
|||
when (Map.member var $ csDefinitions st) $
|
||||
dieP m $ "Preprocessor symbol is already defined: " ++ var
|
||||
put $ st { csDefinitions = Map.insert var value $ csDefinitions st }
|
||||
return (return, id)
|
||||
return return
|
||||
|
||||
-- | Handle the @#UNDEF@ directive.
|
||||
handleUndef :: DirectiveFunc
|
||||
handleUndef m [var]
|
||||
= do modify $ \st -> st { csDefinitions = Map.delete var $ csDefinitions st }
|
||||
return (return, id)
|
||||
return return
|
||||
|
||||
-- | Handle the @#IF@ directive.
|
||||
handleIf :: DirectiveFunc
|
||||
handleIf m [condition]
|
||||
= do b <- runPreprocParser m expression condition
|
||||
return (skipCondition b 0, id)
|
||||
return $ skipCondition b 0
|
||||
where
|
||||
skipCondition :: Bool -> Int -> [Token] -> PassM [Token]
|
||||
skipCondition _ _ [] = dieP m "Couldn't find a matching #ENDIF"
|
||||
|
||||
-- At level 0, we flip state on ELSE and finish on ENDIF.
|
||||
skipCondition b 0 (t1@(_, TokPreprocessor pp) : t2@(_, EndOfLine) : ts)
|
||||
| "#IF" `isPrefixOf` pp = skipCondition b 1 ts >>* (\ts -> t1 : t2 : ts)
|
||||
skipCondition b 0 (t@(_, TokPreprocessor pp):ts)
|
||||
| "#IF" `isPrefixOf` pp = skipCondition b 1 ts >>* (t :)
|
||||
| "#ELSE" `isPrefixOf` pp = skipCondition (not b) 0 ts
|
||||
| "#ENDIF" `isPrefixOf` pp = return ts
|
||||
| otherwise = copyThrough b 0 ((t1 :) . (t2 :)) ts
|
||||
| otherwise = copyThrough b 0 t ts
|
||||
|
||||
-- At higher levels, we just count up and down on IF and ENDIF.
|
||||
skipCondition b n (t1@(_, TokPreprocessor pp) : t2@(_, EndOfLine) : ts)
|
||||
| "#IF" `isPrefixOf` pp = skipCondition b (n + 1) ts >>* (\ts -> t1 : t2 : ts)
|
||||
| "#ENDIF" `isPrefixOf` pp = skipCondition b (n - 1) ts >>* (\ts -> t1 : t2 : ts)
|
||||
| otherwise = copyThrough b n ((t1 :) . (t2 :)) ts
|
||||
skipCondition b n (t@(_, TokPreprocessor pp):ts)
|
||||
| "#IF" `isPrefixOf` pp = skipCondition b (n + 1) ts >>* (t :)
|
||||
| "#ENDIF" `isPrefixOf` pp = skipCondition b (n - 1) ts >>* (t :)
|
||||
| otherwise = copyThrough b n t ts
|
||||
|
||||
-- And otherwise we copy through tokens if the condition's true.
|
||||
skipCondition b n (t:ts) = copyThrough b n (t :) ts
|
||||
skipCondition b n (t:ts) = copyThrough b n t ts
|
||||
|
||||
copyThrough :: Bool -> Int -> ([Token] -> [Token]) -> [Token] -> PassM [Token]
|
||||
copyThrough True n f ts = skipCondition True n ts >>* f
|
||||
copyThrough :: Bool -> Int -> Token -> [Token] -> PassM [Token]
|
||||
copyThrough True n t ts = skipCondition True n ts >>* (t :)
|
||||
copyThrough False n _ ts = skipCondition False n ts
|
||||
--}}}
|
||||
|
||||
|
|
|
|||
|
|
@ -36,9 +36,9 @@ testPP n itts etts = TestCase $ testPass ("testPP " ++ show n) (makeTokens etts)
|
|||
-- | Test a preprocessor condition string after a series of tokens.
|
||||
testPPCondAfter :: Int -> [TokenType] -> String -> Bool -> Test
|
||||
testPPCondAfter n tts condition exp
|
||||
= testPP n (tts ++ [TokPreprocessor $ "#IF " ++ condition, EndOfLine,
|
||||
= testPP n (tts ++ [TokPreprocessor $ "#IF " ++ condition,
|
||||
TokIdentifier "abc",
|
||||
TokPreprocessor $ "#ENDIF", EndOfLine])
|
||||
TokPreprocessor $ "#ENDIF"])
|
||||
(if exp then [TokIdentifier "abc"] else [])
|
||||
|
||||
-- | Test a preprocessor condition string.
|
||||
|
|
@ -52,54 +52,67 @@ testPPFail n itts = TestCase $ testPassShouldFail ("testPPFail " ++ show n) pass
|
|||
makeTokens = zip (repeat emptyMeta)
|
||||
pass = preprocessOccam (makeTokens itts)
|
||||
|
||||
-- | Test 'expandIncludes' when we're expecting it to succeed.
|
||||
testEI :: Int -> [TokenType] -> [TokenType] -> Test
|
||||
testEI n itts etts = TestCase $ testPass ("testEI " ++ show n) (makeTokens etts) pass (return ())
|
||||
where
|
||||
makeTokens = zip (repeat emptyMeta)
|
||||
pass = expandIncludes (makeTokens itts)
|
||||
|
||||
-- | Test 'expandIncludes' when we're expecting it to fail.
|
||||
testEIFail :: Int -> [TokenType] -> Test
|
||||
testEIFail n itts = TestCase $ testPassShouldFail ("testEIFail " ++ show n) pass (return ())
|
||||
where
|
||||
makeTokens = zip (repeat emptyMeta)
|
||||
pass = expandIncludes (makeTokens itts)
|
||||
|
||||
--{{{ 0xxx simple stuff
|
||||
testSimple :: Test
|
||||
testSimple = TestLabel "testSimple" $ TestList
|
||||
[ testPP 0 [] []
|
||||
, testPP 10 [tp "#COMMENT blah", eol] []
|
||||
, testPP 10 [tp "#COMMENT blah"] []
|
||||
, testPP 20 arbitrary arbitrary
|
||||
, testPPFail 900 [tp "#INCLUDE \"this-should-not-exist.inc\"", eol]
|
||||
, testPP 30 [tp "#INCLUDE \"foo\""] [IncludeFile "foo"]
|
||||
]
|
||||
where
|
||||
tp = TokPreprocessor
|
||||
eol = EndOfLine
|
||||
arbitrary = [Indent, Outdent, EndOfLine, TokReserved "blah", TokIdentifier "bleh"]
|
||||
--}}}
|
||||
--{{{ 1xxx #IF/#ELSE/#ENDIF
|
||||
testIf :: Test
|
||||
testIf = TestLabel "testIf" $ TestList
|
||||
-- Simple conditionals
|
||||
[ testPP 1000 [tp "#IF TRUE", eol, ti "abc", tp "#ENDIF", eol] [ti "abc"]
|
||||
, testPP 1010 [tp "#IF FALSE", eol, ti "abc", tp "#ENDIF", eol] []
|
||||
, testPP 1020 [tp "#IF TRUE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol] [ti "abc"]
|
||||
, testPP 1030 [tp "#IF FALSE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol] [ti "def"]
|
||||
, testPP 1040 [tp "#IF FALSE", eol, tp "#INCLUDE \"does-not-exist.inc\"", eol, tp "#ENDIF", eol] []
|
||||
[ testPP 1000 [tp "#IF TRUE", ti "abc", tp "#ENDIF"] [ti "abc"]
|
||||
, testPP 1010 [tp "#IF FALSE", ti "abc", tp "#ENDIF"] []
|
||||
, testPP 1020 [tp "#IF TRUE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF"] [ti "abc"]
|
||||
, testPP 1030 [tp "#IF FALSE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF"] [ti "def"]
|
||||
, testPP 1040 [tp "#IF FALSE", tp "#INCLUDE \"does-not-exist.inc\"", tp "#ENDIF"] []
|
||||
|
||||
-- Nested conditionals
|
||||
, testPP 1100 [tp "#IF FALSE", eol, tp "#IF FALSE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] []
|
||||
, testPP 1110 [tp "#IF FALSE", eol, tp "#IF TRUE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] []
|
||||
, testPP 1120 [tp "#IF TRUE", eol, tp "#IF FALSE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] []
|
||||
, testPP 1130 [tp "#IF TRUE", eol, tp "#IF TRUE", eol, ti "abc", tp "#ENDIF", eol, tp "#ENDIF", eol] [ti "abc"]
|
||||
, testPP 1140 [tp "#IF FALSE", eol,
|
||||
tp "#IF FALSE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol,
|
||||
tp "#ELSE", eol,
|
||||
, testPP 1100 [tp "#IF FALSE", tp "#IF FALSE", ti "abc", tp "#ENDIF", tp "#ENDIF"] []
|
||||
, testPP 1110 [tp "#IF FALSE", tp "#IF TRUE", ti "abc", tp "#ENDIF", tp "#ENDIF"] []
|
||||
, testPP 1120 [tp "#IF TRUE", tp "#IF FALSE", ti "abc", tp "#ENDIF", tp "#ENDIF"] []
|
||||
, testPP 1130 [tp "#IF TRUE", tp "#IF TRUE", ti "abc", tp "#ENDIF", tp "#ENDIF"] [ti "abc"]
|
||||
, testPP 1140 [tp "#IF FALSE",
|
||||
tp "#IF FALSE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF",
|
||||
tp "#ELSE",
|
||||
ti "ghi",
|
||||
tp "#ENDIF", eol] [ti "ghi"]
|
||||
, testPP 1150 [tp "#IF FALSE", eol,
|
||||
tp "#IF TRUE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol,
|
||||
tp "#ELSE", eol,
|
||||
tp "#ENDIF"] [ti "ghi"]
|
||||
, testPP 1150 [tp "#IF FALSE",
|
||||
tp "#IF TRUE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF",
|
||||
tp "#ELSE",
|
||||
ti "ghi",
|
||||
tp "#ENDIF", eol] [ti "ghi"]
|
||||
, testPP 1160 [tp "#IF TRUE", eol,
|
||||
tp "#IF FALSE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol,
|
||||
tp "#ELSE", eol,
|
||||
tp "#ENDIF"] [ti "ghi"]
|
||||
, testPP 1160 [tp "#IF TRUE",
|
||||
tp "#IF FALSE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF",
|
||||
tp "#ELSE",
|
||||
ti "ghi",
|
||||
tp "#ENDIF", eol] [ti "def"]
|
||||
, testPP 1170 [tp "#IF TRUE", eol,
|
||||
tp "#IF TRUE", eol, ti "abc", tp "#ELSE", eol, ti "def", tp "#ENDIF", eol,
|
||||
tp "#ELSE", eol,
|
||||
tp "#ENDIF"] [ti "def"]
|
||||
, testPP 1170 [tp "#IF TRUE",
|
||||
tp "#IF TRUE", ti "abc", tp "#ELSE", ti "def", tp "#ENDIF",
|
||||
tp "#ELSE",
|
||||
ti "ghi",
|
||||
tp "#ENDIF", eol] [ti "abc"]
|
||||
tp "#ENDIF"] [ti "abc"]
|
||||
|
||||
-- Expressions
|
||||
, testPPCond 1200 "FALSE AND FALSE" False
|
||||
|
|
@ -128,57 +141,56 @@ testIf = TestLabel "testIf" $ TestList
|
|||
, testPPCond 1430 "((3 > 4) OR (42 = 24)) AND (1 <= 2)" False
|
||||
|
||||
-- Invalid conditionals
|
||||
, testPPFail 1900 [tp "#IF you can keep your head when all about you...", eol]
|
||||
, testPPFail 1910 [tp "#IF TRUE", eol]
|
||||
, testPPFail 1920 [tp "#IF TRUE love comes but once in a lifetime...", eol]
|
||||
, testPPFail 1930 [tp "#IF TRUE", eol, tp "#IF FALSE", eol, tp "#ENDIF", eol]
|
||||
, testPPFail 1940 [tp "#IF (TRUE", eol, tp "#ENDIF", eol]
|
||||
, testPPFail 1950 [tp "#ELSE", eol]
|
||||
, testPPFail 1960 [tp "#ENDIF", eol]
|
||||
, testPPFail 1970 [tp "#IF 3 = \"foo\"", eol, tp "#ENDIF", eol]
|
||||
, testPPFail 1980 [tp "#IF \"foo\" > \"bar\"", eol, tp "#ENDIF", eol]
|
||||
, testPPFail 1900 [tp "#IF you can keep your head when all about you..."]
|
||||
, testPPFail 1910 [tp "#IF TRUE"]
|
||||
, testPPFail 1920 [tp "#IF TRUE love comes but once in a lifetime..."]
|
||||
, testPPFail 1930 [tp "#IF TRUE", tp "#IF FALSE", tp "#ENDIF"]
|
||||
, testPPFail 1940 [tp "#IF (TRUE", tp "#ENDIF"]
|
||||
, testPPFail 1950 [tp "#ELSE"]
|
||||
, testPPFail 1960 [tp "#ENDIF"]
|
||||
, testPPFail 1970 [tp "#IF 3 = \"foo\"", tp "#ENDIF"]
|
||||
, testPPFail 1980 [tp "#IF \"foo\" > \"bar\"", tp "#ENDIF"]
|
||||
]
|
||||
where
|
||||
ti = TokIdentifier
|
||||
tp = TokPreprocessor
|
||||
eol = EndOfLine
|
||||
--}}}
|
||||
--{{{ 2xxx #DEFINE/#UNDEF/##
|
||||
testDefine :: Test
|
||||
testDefine = TestLabel "testDefine" $ TestList
|
||||
-- Basic defining
|
||||
[ testPP 2000 [tp "#DEFINE FOO", eol] []
|
||||
, testPP 2010 [tp "#DEFINE FOO \"bar\"", eol] []
|
||||
, testPP 2020 [tp "#DEFINE FOO 42", eol] []
|
||||
, testPP 2030 [tp "#UNDEF BAR", eol] []
|
||||
, testPP 2040 [tp "#DEFINE FOO", eol, tp "#UNDEF FOO", eol] []
|
||||
[ testPP 2000 [tp "#DEFINE FOO"] []
|
||||
, testPP 2010 [tp "#DEFINE FOO \"bar\""] []
|
||||
, testPP 2020 [tp "#DEFINE FOO 42"] []
|
||||
, testPP 2030 [tp "#UNDEF BAR"] []
|
||||
, testPP 2040 [tp "#DEFINE FOO", tp "#UNDEF FOO"] []
|
||||
|
||||
-- DEFINED
|
||||
, testPPCondAfter 2100 [tp "#DEFINE FOO", eol] "DEFINED (FOO)" True
|
||||
, testPPCondAfter 2110 [tp "#UNDEF FOO", eol] "DEFINED (FOO)" False
|
||||
, testPPCondAfter 2120 [tp "#DEFINE FOO", eol, tp "#UNDEF FOO", eol]
|
||||
"DEFINED (FOO)" False
|
||||
, testPPCondAfter 2130 [tp "#UNDEF FOO", eol, tp "#DEFINE FOO", eol]
|
||||
"DEFINED (FOO)" True
|
||||
, testPPCond 2140 "DEFINED (COMPILER.TOCK)" True
|
||||
, testPPCond 2150 "NOT DEFINED (COMPILER.TOCK)" False
|
||||
, testPPCondAfter 2100 [tp "#DEFINE FOO"] "DEFINED (FOO)" True
|
||||
, testPPCondAfter 2110 [tp "#UNDEF FOO"] "DEFINED (FOO)" False
|
||||
, testPPCondAfter 2120 [tp "#DEFINE FOO", tp "#UNDEF FOO"]
|
||||
"DEFINED (FOO)" False
|
||||
, testPPCondAfter 2130 [tp "#UNDEF FOO", tp "#DEFINE FOO"]
|
||||
"DEFINED (FOO)" True
|
||||
, testPPCond 2140 "DEFINED (COMPILER.TOCK)" True
|
||||
, testPPCond 2150 "NOT DEFINED (COMPILER.TOCK)" False
|
||||
|
||||
-- Conditions involving macros
|
||||
, testPPCondAfter 2200 [tp "#DEFINE FOO 42", eol] "FOO = 42" True
|
||||
, testPPCondAfter 2210 [tp "#DEFINE FOO 42", eol] "FOO <> 42" False
|
||||
, testPPCondAfter 2220 [tp "#DEFINE FOO \"bar\"", eol] "FOO = \"bar\"" True
|
||||
, testPPCondAfter 2230 [tp "#DEFINE FOO \"baz\"", eol] "FOO = \"bar\"" False
|
||||
, testPPCondAfter 2200 [tp "#DEFINE FOO 42"] "FOO = 42" True
|
||||
, testPPCondAfter 2210 [tp "#DEFINE FOO 42"] "FOO <> 42" False
|
||||
, testPPCondAfter 2220 [tp "#DEFINE FOO \"bar\""] "FOO = \"bar\"" True
|
||||
, testPPCondAfter 2230 [tp "#DEFINE FOO \"baz\""] "FOO = \"bar\"" False
|
||||
|
||||
-- Expansion
|
||||
, testPP 2600 [tp "#DEFINE FOO \"bar\"", eol, hh, ti "FOO"] [TokStringLiteral "bar"]
|
||||
, testPP 2610 [tp "#DEFINE FOO 1234", eol, hh, ti "FOO"] [TokIntLiteral "1234"]
|
||||
, testPP 2600 [tp "#DEFINE FOO \"bar\"", hh, ti "FOO"] [TokStringLiteral "bar"]
|
||||
, testPP 2610 [tp "#DEFINE FOO 1234", hh, ti "FOO"] [TokIntLiteral "1234"]
|
||||
|
||||
-- Invalid definitions
|
||||
, testPPFail 2900 [tp "#DEFINE FOO", eol, tp "#DEFINE FOO", eol]
|
||||
, testPPFail 2910 [tp "#DEFINE FOO !!*!%*!", eol]
|
||||
, testPPFail 2900 [tp "#DEFINE FOO", tp "#DEFINE FOO"]
|
||||
, testPPFail 2910 [tp "#DEFINE FOO !!*!%*!"]
|
||||
|
||||
-- Invalid expansions
|
||||
, testPPFail 2950 [tp "#DEFINE FOO", eol, hh, ti "FOO"]
|
||||
, testPPFail 2950 [tp "#DEFINE FOO", hh, ti "FOO"]
|
||||
, testPPFail 2960 [hh, ti "FOO"]
|
||||
, testPPFail 2970 [hh, hh]
|
||||
]
|
||||
|
|
@ -186,7 +198,17 @@ testDefine = TestLabel "testDefine" $ TestList
|
|||
tp = TokPreprocessor
|
||||
ti = TokIdentifier
|
||||
hh = TokReserved "##"
|
||||
eol = EndOfLine
|
||||
--}}}
|
||||
--{{{ 3xxx expandIncludes
|
||||
testExpand :: Test
|
||||
testExpand = TestLabel "testExpand" $ TestList
|
||||
[ testEI 3000 [] []
|
||||
, testEI 3010 arbitrary arbitrary
|
||||
|
||||
, testEIFail 3900 [IncludeFile "this-does-not-exist", EndOfLine]
|
||||
]
|
||||
where
|
||||
arbitrary = [Indent, Outdent, EndOfLine, TokReserved "blah", TokIdentifier "bleh"]
|
||||
--}}}
|
||||
|
||||
tests :: Test
|
||||
|
|
@ -194,4 +216,5 @@ tests = TestLabel "PreprocessOccamTest" $ TestList
|
|||
[ testSimple
|
||||
, testIf
|
||||
, testDefine
|
||||
, testExpand
|
||||
]
|
||||
|
|
|
|||
|
|
@ -49,11 +49,12 @@ structureOccam ts = analyse 1 firstLine ts (emptyMeta, EndOfLine)
|
|||
analyse prevCol _ [] _ = return $ (emptyMeta, EndOfLine) : out
|
||||
where out = replicate (prevCol `div` 2) (emptyMeta, Outdent)
|
||||
analyse prevCol prevLine (t@(m, tokType):ts) prevTok
|
||||
= if (line /= prevLine) && (not isContinuation)
|
||||
then do rest <- analyse col line ts t
|
||||
newLine $ t : rest
|
||||
else do rest <- analyse prevCol line ts t
|
||||
return $ t : rest
|
||||
| line /= prevLine && not isContinuation
|
||||
= do rest <- analyse col line ts t
|
||||
newLine $ t : rest
|
||||
| otherwise
|
||||
= do rest <- analyse prevCol line ts t
|
||||
return $ t : rest
|
||||
where
|
||||
col = metaColumn m
|
||||
line = metaLine m
|
||||
|
|
|
|||
|
|
@ -51,6 +51,10 @@ testSimple = TestLabel "testSimple" $ TestList
|
|||
, testS 50 [(m 1 1, foo), (m 2 3, foo), (m 3 3, foo), (m 4 3, foo)]
|
||||
[fooP, eolP, inP, fooP, eolP, fooP, eolP, fooP, eolP, outP]
|
||||
|
||||
-- Ignoring include markers
|
||||
, testS 100 [(m 1 1, IncludeFile "bar"), (m 2 1, foo)]
|
||||
[tag1 IncludeFile "bar", eolP, fooP, eolP]
|
||||
|
||||
-- Things that should fail
|
||||
, testSFail 900 [(m 1 1, foo), (m 2 2, foo)]
|
||||
, testSFail 910 [(m 1 1, foo), (m 2 5, foo)]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user