From f37204f544f8e1165e0451b0f7abd3ec759018e1 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 17 Mar 2026 08:59:49 -0400 Subject: [PATCH 1/3] Add a lang-tests exe to Cabal-tests --- Cabal-tests/Cabal-tests.cabal | 10 ++++++++++ .../tests/misc/ghc-supported-languages.hs | 18 +++++++++--------- 2 files changed, 19 insertions(+), 9 deletions(-) diff --git a/Cabal-tests/Cabal-tests.cabal b/Cabal-tests/Cabal-tests.cabal index f9fe954f76f..7989b532bed 100644 --- a/Cabal-tests/Cabal-tests.cabal +++ b/Cabal-tests/Cabal-tests.cabal @@ -200,3 +200,13 @@ test-suite no-thunks-test if impl(ghc >=8.6) build-depends: , nothunks >=0.1.1.0 && <0.3 + +executable lang-tests + hs-source-dirs: tests/misc + main-is: ghc-supported-languages.hs + build-depends: + , base + , Cabal + + ghc-options: -Wall + default-language: Haskell2010 diff --git a/Cabal-tests/tests/misc/ghc-supported-languages.hs b/Cabal-tests/tests/misc/ghc-supported-languages.hs index e8036a0364b..07c5febb9c0 100644 --- a/Cabal-tests/tests/misc/ghc-supported-languages.hs +++ b/Cabal-tests/tests/misc/ghc-supported-languages.hs @@ -1,22 +1,22 @@ +{-# LANGUAGE TypeApplications #-} + -- | A test program to check that ghc has got all of its extensions registered --- module Main where +import Distribution.Compat.Prelude import Language.Haskell.Extension import Distribution.Text import Distribution.Simple.Utils import Distribution.Verbosity +import qualified Distribution.Verbosity as V +import Distribution.Simple.Errors import Data.List ((\\)) -import Data.Maybe -import Control.Applicative -import Control.Monad import System.Environment -import System.Exit -- | A list of GHC extensions that are deliberately not registered, -- e.g. due to being experimental and not ready for public consumption --- +exceptions :: [Extension] exceptions = map readExtension [] checkProblems :: [Extension] -> [String] @@ -69,8 +69,8 @@ checkProblems implemented = check [] _ = Nothing check _ i = Just i - -main = topHandler $ do +main :: IO a +main = topHandler (isUserException (Proxy @(VerboseException CabalException))) $ do [ghcPath] <- getArgs exts <- getExtensions ghcPath let problems = checkProblems exts @@ -82,7 +82,7 @@ main = topHandler $ do getExtensions :: FilePath -> IO [Extension] getExtensions ghcPath = map readExtension . lines - <$> rawSystemStdout normal ghcPath ["--supported-languages"] + <$> rawSystemStdout (Verbosity V.normal defaultVerbosityHandles) ghcPath ["--supported-languages"] readExtension :: String -> Extension readExtension str = handleNoParse $ do From 0ee719886449646b96d49903c5aab4f95ee11884 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 17 Mar 2026 09:04:05 -0400 Subject: [PATCH 2/3] Format ghc-supported-languages module --- .../tests/misc/ghc-supported-languages.hs | 96 +++++++++---------- Makefile | 3 +- 2 files changed, 49 insertions(+), 50 deletions(-) diff --git a/Cabal-tests/tests/misc/ghc-supported-languages.hs b/Cabal-tests/tests/misc/ghc-supported-languages.hs index 07c5febb9c0..55de8032f8f 100644 --- a/Cabal-tests/tests/misc/ghc-supported-languages.hs +++ b/Cabal-tests/tests/misc/ghc-supported-languages.hs @@ -4,12 +4,12 @@ module Main where import Distribution.Compat.Prelude -import Language.Haskell.Extension -import Distribution.Text +import Distribution.Simple.Errors import Distribution.Simple.Utils +import Distribution.Text import Distribution.Verbosity import qualified Distribution.Verbosity as V -import Distribution.Simple.Errors +import Language.Haskell.Extension import Data.List ((\\)) import System.Environment @@ -21,58 +21,56 @@ exceptions = map readExtension [] checkProblems :: [Extension] -> [String] checkProblems implemented = - - let unregistered = - [ ext | ext <- implemented -- extensions that ghc knows about - , not (registered ext) -- but that are not registered - , ext `notElem` exceptions ] -- except for the exceptions + -- Extensions that ghc knows about but that are not registered except for the exceptions + let unregistered = [ext | ext <- implemented, not (registered ext), ext `notElem` exceptions] -- check if someone has forgotten to update the exceptions list... - -- exceptions that are not implemented - badExceptions = exceptions \\ implemented + badExceptions = exceptions \\ implemented -- exceptions that are now registered badExceptions' = filter registered exceptions - in catMaybes - [ check unregistered $ unlines - [ "The following extensions are known to GHC but are not in the " - , "extension registry in Language.Haskell.Extension." - , " " ++ intercalate "\n " (map display unregistered) - , "If these extensions are ready for public consumption then they " - , "should be registered. If they are still experimental and you " - , "think they are not ready to be registered then please add them " - , "to the exceptions list in this test program along with an " - , "explanation." - ] - , check badExceptions $ unlines - [ "Error in the extension exception list. The following extensions" - , "are listed as exceptions but are not even implemented by GHC:" - , " " ++ intercalate "\n " (map display badExceptions) - , "Please fix this test program by correcting the list of" - , "exceptions." - ] - , check badExceptions' $ unlines - [ "Error in the extension exception list. The following extensions" - , "are listed as exceptions to registration but they are in fact" - , "now registered in Language.Haskell.Extension:" - , " " ++ intercalate "\n " (map display badExceptions') - , "Please fix this test program by correcting the list of" - , "exceptions." - ] - ] + [ check unregistered $ + unlines + [ "The following extensions are known to GHC but are not in the " + , "extension registry in Language.Haskell.Extension." + , " " ++ intercalate "\n " (map display unregistered) + , "If these extensions are ready for public consumption then they " + , "should be registered. If they are still experimental and you " + , "think they are not ready to be registered then please add them " + , "to the exceptions list in this test program along with an " + , "explanation." + ] + , check badExceptions $ + unlines + [ "Error in the extension exception list. The following extensions" + , "are listed as exceptions but are not even implemented by GHC:" + , " " ++ intercalate "\n " (map display badExceptions) + , "Please fix this test program by correcting the list of" + , "exceptions." + ] + , check badExceptions' $ + unlines + [ "Error in the extension exception list. The following extensions" + , "are listed as exceptions to registration but they are in fact" + , "now registered in Language.Haskell.Extension:" + , " " ++ intercalate "\n " (map display badExceptions') + , "Please fix this test program by correcting the list of" + , "exceptions." + ] + ] where - registered (UnknownExtension _) = False - registered _ = True + registered (UnknownExtension _) = False + registered _ = True - check [] _ = Nothing - check _ i = Just i + check [] _ = Nothing + check _ i = Just i main :: IO a main = topHandler (isUserException (Proxy @(VerboseException CabalException))) $ do [ghcPath] <- getArgs - exts <- getExtensions ghcPath + exts <- getExtensions ghcPath let problems = checkProblems exts putStrLn (intercalate "\n" problems) if null problems @@ -81,17 +79,17 @@ main = topHandler (isUserException (Proxy @(VerboseException CabalException))) $ getExtensions :: FilePath -> IO [Extension] getExtensions ghcPath = - map readExtension . lines + map readExtension . lines <$> rawSystemStdout (Verbosity V.normal defaultVerbosityHandles) ghcPath ["--supported-languages"] readExtension :: String -> Extension readExtension str = handleNoParse $ do - -- GHC defines extensions in a positive way, Cabal defines them - -- relative to H98 so we try parsing ("No" ++ extName) first - ext <- simpleParse ("No" ++ str) - case ext of - UnknownExtension _ -> simpleParse str - _ -> return ext + -- GHC defines extensions in a positive way, Cabal defines them + -- relative to H98 so we try parsing ("No" ++ extName) first + ext <- simpleParse ("No" ++ str) + case ext of + UnknownExtension _ -> simpleParse str + _ -> return ext where handleNoParse :: Maybe Extension -> Extension handleNoParse = fromMaybe (error $ "unparsable extension " ++ show str) diff --git a/Makefile b/Makefile index 9b0cae9f668..f0bf50e6e72 100644 --- a/Makefile +++ b/Makefile @@ -31,7 +31,8 @@ FORMAT_DIRS := \ Cabal-syntax \ cabal-install \ cabal-testsuite/src \ - cabal-validate + cabal-validate \ + Cabal-tests/tests/misc FORMAT_DIRS_TODO := \ Cabal-QuickCheck \ From 629050f9b36d26e3a94a1f41b61a6849d9b95686 Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Tue, 17 Mar 2026 10:03:18 -0400 Subject: [PATCH 3/3] Add an args check with help --- .../tests/misc/ghc-supported-languages.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/Cabal-tests/tests/misc/ghc-supported-languages.hs b/Cabal-tests/tests/misc/ghc-supported-languages.hs index 55de8032f8f..597d5a9e46f 100644 --- a/Cabal-tests/tests/misc/ghc-supported-languages.hs +++ b/Cabal-tests/tests/misc/ghc-supported-languages.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} -- | A test program to check that ghc has got all of its extensions registered @@ -69,13 +70,15 @@ checkProblems implemented = main :: IO a main = topHandler (isUserException (Proxy @(VerboseException CabalException))) $ do - [ghcPath] <- getArgs - exts <- getExtensions ghcPath - let problems = checkProblems exts - putStrLn (intercalate "\n" problems) - if null problems - then exitSuccess - else exitFailure + getArgs >>= \case + [ghcPath] -> do + exts <- getExtensions ghcPath + let problems = checkProblems exts + putStrLn (intercalate "\n" problems) + if null problems + then exitSuccess + else exitFailure + _ -> dieNoVerbosity "needs the path to ghc as the single argument" getExtensions :: FilePath -> IO [Extension] getExtensions ghcPath =