diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,5 +1,15 @@ +Changes in 0.25.0.2 + - Fix a bug with `--no-magic` handling which was introduced with `0.25.0.1`. + +Changes in 0.25.0.1 (deprecated) + - Discard `--interactive` from response files. This fixes a critical bug + introduced with `0.25.0` (see #487). + +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.2 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/Cabal/ReplOptions.hs b/src/Cabal/ReplOptions.hs --- a/src/Cabal/ReplOptions.hs +++ b/src/Cabal/ReplOptions.hs @@ -32,6 +32,7 @@ , Option "libdir" Nothing (Argument "DIR") "installation directory for libraries" , Option "libsubdir" Nothing (Argument "DIR") "subdirectory of libdir in which libs are installed" , Option "dynlibdir" Nothing (Argument "DIR") "installation directory for dynamic libraries" + , Option "bytecodelibdir" Nothing (Argument "DIR") "installation directory for bytecode libraries" , Option "libexecdir" Nothing (Argument "DIR") "installation directory for program executables" , Option "libexecsubdir" Nothing (Argument "DIR") "subdirectory of libexecdir in which private executables are installed" , Option "datadir" Nothing (Argument "DIR") "installation directory for read-only data" @@ -50,6 +51,8 @@ , Option "disable-shared" Nothing NoArgument "Disable Shared library" , Option "enable-static" Nothing NoArgument "Enable Static library" , Option "disable-static" Nothing NoArgument "Disable Static library" + , Option "enable-library-bytecode" Nothing NoArgument "Enable Bytecode library" + , Option "disable-library-bytecode" Nothing NoArgument "Disable Bytecode library" , Option "enable-executable-dynamic" Nothing NoArgument "Enable Executable dynamic linking" , Option "disable-executable-dynamic" Nothing NoArgument "Disable Executable dynamic linking" , Option "enable-executable-static" Nothing NoArgument "Enable Executable fully static linking" @@ -184,6 +187,7 @@ , Option "project-dir" Nothing (Argument "DIR") "Set the path of the project directory" , Option "project-file" Nothing (Argument "FILE") "Set the path of the cabal.project file (relative to the project directory when relative)" , Option "ignore-project" (Just 'z') NoArgument "Ignore local project configuration (unless --project-dir or --project-file is also set)" + , Option "project-file-parser" Nothing (Argument "PARSER") "Set the parser to use for the project file" , Option "repl-no-load" Nothing NoArgument "Disable loading of project modules at REPL startup." , Option "repl-options" Nothing (Argument "FLAG") "Use the option(s) for the repl" , Option "repl-multi-file" Nothing (Argument "DIR") "Write repl options to this directory rather than starting repl mode" 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,8 +24,11 @@ import GHC.Utils.Monad (liftIO) #endif +import GHC.ResponseFile (expandResponse) import System.Exit (exitFailure) +import Options (discardInteractiveFlag) + -- Catch GHC source errors, print them and exit. handleSrcErrors :: Ghc a -> Ghc a handleSrcErrors action' = flip handleSourceError action' $ \err -> do @@ -33,16 +37,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 . discardInteractiveFlag >>= 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 +55,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/Options.hs b/src/Options.hs --- a/src/Options.hs +++ b/src/Options.hs @@ -1,10 +1,12 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} module Options ( Result(..) , Run(..) , Config(..) , defaultConfig , parseOptions +, discardInteractiveFlag #ifdef TEST , defaultRun , usage @@ -71,7 +73,7 @@ , preserveIt = False , failFast = False , verbose = False -, repl = (ghc, ["--interactive"]) +, repl = (ghc, [interactiveFlag]) } nonInteractiveGhcOptions :: [String] @@ -118,17 +120,33 @@ parseOptions :: [String] -> Result Run parseOptions args | on "--info" = Output info - | on "--interactive" = runRunOptionsParser (discard "--interactive" args) defaultRun $ do + | on interactiveFlag = runRunOptionsParser (discardInteractiveFlag args) defaultRun $ do commonRunOptions + parseFlag "--no-magic" (setMagicMode False) | on `any` nonInteractiveGhcOptions = ProxyToGhc args | on "--help" = Output usage | on "--version" = Output versionInfo + | any isResponseFile args = runRunOptionsParser args defaultRun $ do + commonRunOptions + parseFlag "--no-magic" (setMagicMode False) | otherwise = runRunOptionsParser args defaultRun {runMagicMode = True} $ do commonRunOptions parseFlag "--no-magic" (setMagicMode False) parseOptGhc where + on :: String -> Bool on option = option `elem` args + + isResponseFile :: String -> Bool + isResponseFile = \ case + '@' : _ -> True + _ -> False + +interactiveFlag :: String +interactiveFlag = "--interactive" + +discardInteractiveFlag :: [String] -> [String] +discardInteractiveFlag = discard interactiveFlag type RunOptionsParser = RWS () (Endo Run) [String] () 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/OptionsSpec.hs b/test/OptionsSpec.hs --- a/test/OptionsSpec.hs +++ b/test/OptionsSpec.hs @@ -50,6 +50,12 @@ it "accepts --fast" $ do fastMode . runConfig <$> parseOptions ("--fast" : options) `shouldBe` Result True + context "with a response file" $ do + let options = ["--foo", "@args.rsp", "--bar"] + + it "disables magic mode" $ do + runMagicMode <$> parseOptions options `shouldBe` Result False + describe "--no-magic" $ do context "without --no-magic" $ do it "enables magic mode" $ 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 - [] -> []