Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: dbedd927 by Alan Zimmerman at 2025-06-14T09:51:38+01:00 Working on CPP diagnostic reporting - - - - - 3 changed files: - compiler/GHC/Parser/PreProcess/Macro.hs - testsuite/tests/ghc-cpp/GhcCpp02.hs - testsuite/tests/ghc-cpp/GhcCpp02.stderr Changes: ===================================== compiler/GHC/Parser/PreProcess/Macro.hs ===================================== @@ -34,6 +34,7 @@ details import Data.Map qualified as Map import Data.Maybe +import Data.List (intercalate) import Data.Semigroup qualified as S import GHC.Parser.PreProcess.Eval @@ -74,7 +75,7 @@ expand loc s str = do addGhcCPPError loc ( hang - (text "Error evaluating CPP condition1:") -- AZ:TODO remove 1 + (text "Error evaluating CPP condition:") 2 (text err <+> text "of" $+$ text str) ) @@ -88,7 +89,6 @@ maxExpansions = 15 expandToks :: SrcSpan -> Int -> MacroDefines -> [Token] -> PP [Token] expandToks loc 0 _ ts = do - -- error $ "macro_expansion limit (" ++ show maxExpansions ++ ") hit, aborting. ts=" ++ show ts addGhcCPPError loc ( hang @@ -110,21 +110,35 @@ doExpandToks loc ed s (TIdentifierLParen n : ts) = -- restore it to its constituent tokens doExpandToks loc ed s (TIdentifier (init n) : TOpenParen "(" : ts) doExpandToks loc _ s (TIdentifier "defined" : ts) = do - let - -- See Note: [defined unary operator] below - - rest = case getExpandArgs ts of - (Just [[TIdentifier macro_name]], rest0) -> - case Map.lookup macro_name s of - Nothing -> TInteger "0" : rest0 - Just _ -> TInteger "1" : rest0 - (Nothing, TIdentifier macro_name : ts0) -> - case Map.lookup macro_name s of - Nothing -> TInteger "0" : ts0 - Just _ -> TInteger "1" : ts0 - (Nothing, _) -> error $ "defined: expected an identifier, got:" ++ show ts - (Just args, _) -> error $ "defined: expected a single arg, got:" ++ show args - return (True, rest) + -- See Note: ['defined' unary operator] below + case getExpandArgs ts of + (Just [[TIdentifier macro_name]], rest0) -> + case Map.lookup macro_name s of + Nothing -> return (True, TInteger "0" : rest0) + Just _ -> return (True, TInteger "1" : rest0) + (Nothing, TIdentifier macro_name : ts0) -> + case Map.lookup macro_name s of + Nothing -> return (True, TInteger "0" : ts0) + Just _ -> return (True, TInteger "1" : ts0) + (Nothing, _) -> do + addGhcCPPError + loc + ( hang + (text "CPP defined: expected an identifier, got:") + 2 + (text (concatMap t_str ts)) + ) + return (False, []) + (Just args, _) -> do + -- error $ "defined: expected a single arg, got:" ++ show args + addGhcCPPError + loc + ( hang + (text "CPP defined: expected a single arg, got:") + 2 + (text (intercalate "," (map (concatMap t_str) args))) + ) + return (False, []) doExpandToks loc ed s (TIdentifier n : ts) = do let (ed', expanded, ts') = case Map.lookup n s of @@ -144,8 +158,8 @@ doExpandToks loc ed s (t : ts) = do return (ed', t : r) {- -Note: [defined unary operator] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Note: ['defined' unary operator] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From https://timsong-cpp.github.io/cppwp/n4140/cpp#cond-1 ===================================== testsuite/tests/ghc-cpp/GhcCpp02.hs ===================================== @@ -12,3 +12,14 @@ foo = #if EXISTENT_MACRO(4) bar = 3 #endif + +#define FOO(X) FOO(X) +#if FOO(3) + +#endif + +#if defined 34 +#endif + +#if defined(A,B) +#endif ===================================== testsuite/tests/ghc-cpp/GhcCpp02.stderr ===================================== @@ -7,3 +7,27 @@ GhcCpp02.hs:12:1: error: [GHC-93098] Parse error at line 1, column 23 of 2 + NONEXISTENT_MACRO ( 4 ) +GhcCpp02.hs:17:1: error: [GHC-93098] + Error evaluating CPP condition: + Parse error at line 1, column 4 of + FOO( 3 ) + +GhcCpp02.hs:17:1: error: [GHC-93098] + CPP macro expansion limit hit: FOO( 3 ) + +GhcCpp02.hs:21:1: error: [GHC-93098] + Error evaluating CPP condition: + Parse error at line 1, column 0 of + + +GhcCpp02.hs:21:1: error: [GHC-93098] + CPP defined: expected an identifier, got: 34 + +GhcCpp02.hs:24:1: error: [GHC-93098] + Error evaluating CPP condition: + Parse error at line 1, column 0 of + + +GhcCpp02.hs:24:1: error: [GHC-93098] + CPP defined: expected a single arg, got: A,B + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dbedd9273bbad78d40bb413a85c14a9b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dbedd9273bbad78d40bb413a85c14a9b... You're receiving this email because of your account on gitlab.haskell.org.