diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -2,6 +2,8 @@ ------------ * better lexing of Template Haskell single quotes (thanks to Stephan Wehr) * (1.18.1): fix incomplete pattern match + * (1.18.2): bugfix for erroneous boolean intepretation of some macro + expansions in #if clauses Version 1.17 ------------ diff --git a/Language/Preprocessor/Cpphs/CppIfdef.hs b/Language/Preprocessor/Cpphs/CppIfdef.hs --- a/Language/Preprocessor/Cpphs/CppIfdef.hs +++ b/Language/Preprocessor/Cpphs/CppIfdef.hs @@ -34,7 +34,6 @@ import System.IO (hPutStrLn,stderr) import Control.Monad (when) - -- | Run a first pass of cpp, evaluating \#ifdef's and processing \#include's, -- whilst taking account of \#define's and \#undef's as we encounter them. cppIfdef :: FilePath -- ^ File for error reports @@ -185,20 +184,20 @@ parseBoolExp :: SymTab HashDefine -> Parser Bool parseBoolExp st = do a <- parseExp1 st - skip (string "||") - b <- first (skip (parseBoolExp st)) - return (a || b) - +++ - parseExp1 st + (do skip (string "||") + b <- first (skip (parseBoolExp st)) + return (a || b) + +++ + do return a) parseExp1 :: SymTab HashDefine -> Parser Bool parseExp1 st = do a <- parseExp0 st - skip (string "&&") - b <- first (skip (parseExp1 st)) - return (a && b) - +++ - parseExp0 st + (do skip (string "&&") + b <- first (skip (parseExp1 st)) + return (a && b) + +++ + do return a) parseExp0 :: SymTab HashDefine -> Parser Bool parseExp0 st = @@ -206,18 +205,21 @@ sym <- parens parseSym return (definedST sym st) +++ + do () <- expandSymOrCall st + parseBoolExp st + +++ do parens (parseBoolExp st) +++ do skip (char '!') a <- parseExp0 st return (not a) +++ - do sym1 <- parseSymOrCall st - op <- parseOp st - sym2 <- parseSymOrCall st + do sym1 <- skip parseSym + op <- parseOp st + sym2 <- skip parseSym return (op (safeRead sym1) (safeRead sym2)) +++ - do sym <- parseSymOrCall st + do sym <- skip parseSym case safeRead sym of 0 -> return False _ -> return True @@ -252,14 +254,32 @@ do skip (string "!=") return (/=) +-- | Fails if no expansion is required, to prevent infinite recursion. +expandSymOrCall :: SymTab HashDefine -> Parser () +expandSymOrCall st = + do sym <- skip parseSym + args <- parens (parseSymOrCall st `sepby` skip (char ',')) + convert sym args + +++ + do sym <- skip parseSym + convert sym [] + where + convert sym args = + case lookupST sym st of + Nothing -> fail "not a macro" + Just (a@SymbolReplacement{}) -> reparse (replacement a) + Just (a@MacroExpansion{}) -> reparse (expandMacro a args False) + Just (a@AntiDefined{}) -> fail "anti-defined" + +-- | Return the expansion of the symbol (if there is one). parseSymOrCall :: SymTab HashDefine -> Parser String parseSymOrCall st = do sym <- skip parseSym args <- parens (parseSymOrCall st `sepby` skip (char ',')) - return (convert sym args) + return $ convert sym args +++ do sym <- skip parseSym - return (convert sym []) + return $ convert sym [] where convert sym args = case lookupST sym st of @@ -287,3 +307,4 @@ ('<':ns) -> init ns _ -> let ex = recursivelyExpand st name in if ex == name then name else file st ex + diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ LIBRARY = cpphs -VERSION = 1.18.1 +VERSION = 1.18.2 DIRS = Language/Preprocessor/Cpphs \ Text/ParserCombinators diff --git a/Text/ParserCombinators/HuttonMeijer.hs b/Text/ParserCombinators/HuttonMeijer.hs --- a/Text/ParserCombinators/HuttonMeijer.hs +++ b/Text/ParserCombinators/HuttonMeijer.hs @@ -32,7 +32,7 @@ sepby, sepby1, chainl, chainl1, chainr, chainr1, ops, bracket, char, digit, lower, upper, letter, alphanum, string, ident, nat, int, spaces, comment, junk, - skip, token, natural, integer, symbol, identifier) where + skip, token, natural, integer, symbol, identifier, reparse) where import Data.Char import Control.Monad @@ -215,4 +215,14 @@ if not (elem x ks) then return x else return mzero}) +--- Push some tokens back onto the input stream and reparse ------------------ + +-- | This is useful for recursively expanding macros. When the +-- user-parser recognises a macro use, it can lookup the macro +-- expansion from the parse state, lex it, and then stuff the +-- lexed expansion back down into the parser. +reparse :: [Token] -> Parser () +reparse ts = P (\inp-> [((), ts++inp)]) + ------------------------------------------------------------------------------ + diff --git a/cpphs.cabal b/cpphs.cabal --- a/cpphs.cabal +++ b/cpphs.cabal @@ -1,6 +1,6 @@ Name: cpphs -Version: 1.18.1 -Copyright: 2004-2013, Malcolm Wallace +Version: 1.18.2 +Copyright: 2004-2014, Malcolm Wallace License: LGPL License-File: LICENCE-LGPL Cabal-Version: >= 1.6 diff --git a/docs/index.html b/docs/index.html --- a/docs/index.html +++ b/docs/index.html @@ -198,11 +198,12 @@ Current stable version:

-cpphs-1.18.1, release date 2014.02.18
+cpphs-1.18.2, release date 2014.02.24
By HTTP: Hackage.

@@ -224,6 +225,14 @@

Older versions: + +

+cpphs-1.18.1, release date 2014.02.18
+By HTTP: +Hackage. +

cpphs-1.18, release date 2014.02.04
diff --git a/tests/cheplyaka b/tests/cheplyaka new file mode 100644 --- /dev/null +++ b/tests/cheplyaka @@ -0,0 +1,28 @@ +This file tests for a bug reported by Roman Cheplyaka on 2014-02-21. +All results should be YES, but cpphs was giving NO for the first one. +#define x (1 == 1) +#if x +YES +#else +NO +#endif + +#if (1 == 1) +YES +#else +NO +#endif + +#define x 1 == 1 +#if x +YES +#else +NO +#endif + +#define x 0 == 0 +#if x +YES +#else +NO +#endif diff --git a/tests/expect57 b/tests/expect57 new file mode 100644 --- /dev/null +++ b/tests/expect57 @@ -0,0 +1,29 @@ +#line 1 "cheplyaka" +This file tests for a bug reported by Roman Cheplyaka on 2014-02-21. +All results should be YES, but cpphs was giving NO for the first one. + + +YES + + + + + +YES + + + + + + +YES + + + + + + +YES + + + diff --git a/tests/runtests b/tests/runtests --- a/tests/runtests +++ b/tests/runtests @@ -74,4 +74,5 @@ runtest "$CPPHS --strip-eol nomacro" expect54 runtest "$CPPHS ballard" expect55 runtest "$CPPHS th" expect56 +runtest "$CPPHS cheplyaka" expect57 exit $FAIL