diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,5 +1,8 @@ +Changes in 0.25.0 + - Full GHC 9.14 compatibility / `-unit`-support + Changes in 0.24.3 - - GHC 9.14 compatibility. (#478) + - Allow building with GHC 9.14 (#478) Changes in 0.24.2 - Use `GHC.ResponseFile.expandResponse` diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2009-2025 Simon Hengel +Copyright (c) 2009-2026 Simon Hengel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/doctest.cabal b/doctest.cabal --- a/doctest.cabal +++ b/doctest.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.1. +-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack name: doctest -version: 0.24.3 +version: 0.25.0 synopsis: Test interactive Haskell examples description: `doctest` is a tool that checks [examples](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744) and [properties](https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810771856) @@ -18,7 +18,7 @@ homepage: https://github.com/sol/doctest#readme license: MIT license-file: LICENSE -copyright: (c) 2009-2025 Simon Hengel +copyright: (c) 2009-2026 Simon Hengel author: Simon Hengel maintainer: Simon Hengel build-type: Simple diff --git a/src/Cabal.hs b/src/Cabal.hs --- a/src/Cabal.hs +++ b/src/Cabal.hs @@ -66,7 +66,7 @@ withSystemTempDirectory "cabal-doctest" $ \ dir -> do repl ["--keep-temp-files", "--repl-multi-file", dir] files <- filter (isSuffixOf "-inplace") <$> listDirectory dir - options <- concat <$> mapM (fmap lines . readFile . combine dir) files + let options = concatMap (\ file -> ["-unit", '@' : dir file]) files call doctest ("--no-magic" : options) writeFileAtomically :: FilePath -> String -> IO () diff --git a/src/GhcUtil.hs b/src/GhcUtil.hs --- a/src/GhcUtil.hs +++ b/src/GhcUtil.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} -module GhcUtil (withGhc) where +{-# LANGUAGE LambdaCase #-} +module GhcUtil (withGhc, expandUnits) where import Imports @@ -23,6 +24,7 @@ import GHC.Utils.Monad (liftIO) #endif +import GHC.ResponseFile (expandResponse) import System.Exit (exitFailure) -- Catch GHC source errors, print them and exit. @@ -33,16 +35,17 @@ -- | Run a GHC action in Haddock mode withGhc :: [String] -> ([String] -> Ghc a) -> IO a -withGhc flags action = do - flags_ <- handleStaticFlags flags - - runGhc (Just libdir) $ do - handleDynamicFlags flags_ >>= handleSrcErrors . action +withGhc flags action = runGhc (Just libdir) $ do + liftIO (expandUnits flags) >>= handleDynamicFlags >>= handleSrcErrors . action -handleStaticFlags :: [String] -> IO [Located String] -handleStaticFlags flags = return $ map noLoc $ flags +expandUnits :: [String] -> IO [String] +expandUnits = \ case + [] -> return [] + "-unit" : file@('@' : _) : args -> (++) <$> expandResponse [file] <*> expandUnits args + file@('@' : _) : args -> (++) <$> expandResponse [file] <*> expandUnits args + x : xs -> (:) x <$> expandUnits xs -handleDynamicFlags :: GhcMonad m => [Located String] -> m [String] +handleDynamicFlags :: GhcMonad m => [String] -> m [String] handleDynamicFlags flags = do #if __GLASGOW_HASKELL__ >= 901 logger <- getLogger @@ -50,7 +53,7 @@ #else let parseDynamicFlags' = parseDynamicFlags #endif - (dynflags, locSrcs, _) <- (setHaddockMode `fmap` getSessionDynFlags) >>= (`parseDynamicFlags'` flags) + (dynflags, locSrcs, _) <- (setHaddockMode `fmap` getSessionDynFlags) >>= (`parseDynamicFlags'` map noLoc flags) _ <- setSessionDynFlags dynflags -- We basically do the same thing as `ghc/Main.hs` to distinguish diff --git a/src/Run.hs b/src/Run.hs --- a/src/Run.hs +++ b/src/Run.hs @@ -23,7 +23,6 @@ import Imports -import GHC.ResponseFile (expandResponse) import System.Directory (doesFileExist, doesDirectoryExist, getDirectoryContents) import System.Environment (getEnvironment) import System.Exit (exitFailure, exitSuccess) @@ -39,6 +38,10 @@ import GHC.Utils.Panic #endif +#if __GLASGOW_HASKELL__ < 904 +import GhcUtil (expandUnits) +#endif + import PackageDBs import Parse import Options hiding (Result(..)) @@ -64,7 +67,13 @@ doctest = doctestWithRepl (repl defaultConfig) doctestWithRepl :: (String, [String]) -> [String] -> IO () -doctestWithRepl repl = expandResponse >=> \ args0 -> case parseOptions args0 of +#if __GLASGOW_HASKELL__ < 904 +-- GHC versions prior to 9.4.1 don't support response files. For that reason +-- we want to expand early, so that GHCi gets expanded args. +doctestWithRepl repl = expandUnits >=> parseOptions >>> \ case +#else +doctestWithRepl repl = parseOptions >>> \ case +#endif Options.ProxyToGhc args -> exec Interpreter.ghc args Options.Output s -> putStr s Options.Result (Run warnings magicMode config) -> do diff --git a/test/RunSpec.hs b/test/RunSpec.hs --- a/test/RunSpec.hs +++ b/test/RunSpec.hs @@ -11,7 +11,6 @@ import System.Directory (getCurrentDirectory, setCurrentDirectory) import System.IO.Temp (withSystemTempDirectory) import Data.List (isPrefixOf, sort) -import Data.Char import System.IO.Silently import System.IO (stderr) @@ -86,10 +85,9 @@ withSystemTempDirectory "hspec" $ \ dir -> do let file = dir "response-file" writeFile file $ unlines [ - "--verbose" - , "test/integration/testSimple/Fib.hs" + "test/integration/testSimple/Fib.hs" ] - (r, ()) <- hCapture [stderr] $ doctest ['@':file] + (r, ()) <- hCapture [stderr] $ doctest ["--verbose", '@':file] removeLoadedPackageEnvironment r `shouldBe` verboseFibOutput it "prints verbose description of a specification" $ do @@ -132,15 +130,33 @@ describe "doctestWithResult" $ do context "on parse error" $ do let + action :: IO Result action = withCurrentDirectory "test/integration/parse-error" $ do - doctestWithResult defaultConfig { ghcOptions = ["Foo.hs"] } + doctestWithResult defaultConfig { + ghcOptions = [ + "Foo.hs" + -- This is necessary due to: + -- + -- https://gitlab.haskell.org/ghc/ghc/-/commit/88f38b03025386f0f1e8f5861eed67d80495168a + -- + -- It will be fixed by: + -- + -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15995 + -- + , "-fdiagnostics-color=never" +#if __GLASGOW_HASKELL__ >= 910 + , "-fprint-error-index-links=never" +#endif + ] + } + it "aborts with (ExitFailure 1)" $ do hSilence [stderr] action `shouldThrow` (== ExitFailure 1) it "prints a useful error message" $ do (r, _) <- hCapture [stderr] (E.try action :: IO (Either ExitCode Summary)) - stripAnsiColors (removeLoadedPackageEnvironment r) `shouldBe` unlines ( + removeLoadedPackageEnvironment r `shouldBe` unlines ( #if __GLASGOW_HASKELL__ < 910 "" : #endif @@ -169,10 +185,3 @@ let x = "foo bar baz bin" res <- expandDirs x res `shouldBe` [x] - -stripAnsiColors :: String -> String -stripAnsiColors xs = case xs of - '\ESC' : '[' : ';' : ys | 'm' : zs <- dropWhile isNumber ys -> stripAnsiColors zs - '\ESC' : '[' : ys | 'm' : zs <- dropWhile isNumber ys -> stripAnsiColors zs - y : ys -> y : stripAnsiColors ys - [] -> []