doctest 0.9.7 → 0.9.8
raw patch · 6 files changed
+133/−11 lines, 6 filesdep ~hspecPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hspec
API changes (from Hackage documentation)
Files
- doctest.cabal +3/−2
- src/Extract.hs +23/−1
- src/GhcUtil.hs +14/−4
- src/Interpreter.hs +11/−2
- src/Property.hs +5/−2
- src/Sandbox.hs +77/−0
doctest.cabal view
@@ -1,5 +1,5 @@ name: doctest-version: 0.9.7+version: 0.9.8 synopsis: Test interactive Haskell examples description: The doctest program checks examples in source code comments. It is modeled after doctest for Python@@ -45,6 +45,7 @@ , Runner.Example , Run , Util+ , Sandbox build-depends: base == 4.* , ghc >= 7.0 && < 7.8@@ -92,7 +93,7 @@ , transformers , HUnit- , hspec >= 1.3+ , hspec >= 1.5.1 , QuickCheck >= 2.5 , stringbuilder >= 0.4 , silently >= 1.2.4
src/Extract.hs view
@@ -12,8 +12,14 @@ import Control.DeepSeq (deepseq, NFData(rnf)) import Data.Generics +#if __GLASGOW_HASKELL__ < 707 import GHC hiding (flags, Module, Located) import MonadUtils (liftIO, MonadIO)+#else+import GHC hiding (Module, Located)+import DynFlags+import MonadUtils (liftIO)+#endif import Exception (ExceptionMonad) import System.Directory import System.FilePath@@ -28,6 +34,7 @@ import Location hiding (unLoc) import Util (convertDosLineEndings)+import Sandbox (getSandboxArguments) -- | A wrapper around `SomeException`, to allow for a custom `Show` instance. newtype ExtractError = ExtractError SomeException@@ -79,7 +86,12 @@ -- copied from Haddock/Interface.hs enableCompilation :: ModuleGraph -> Ghc ModuleGraph enableCompilation modGraph = do+#if __GLASGOW_HASKELL__ < 707 let enableComp d = d { hscTarget = defaultObjectTarget }+#else+ let enableComp d = let platform = targetPlatform d+ in d { hscTarget = defaultObjectTarget platform }+#endif modifySessionDynFlags enableComp -- We need to update the DynFlags of the ModSummaries as well. let upd m = m { ms_hspp_opts = enableComp (ms_hspp_opts m) }@@ -90,7 +102,15 @@ modifySessionDynFlags :: (DynFlags -> DynFlags) -> Ghc () modifySessionDynFlags f = do dflags <- getSessionDynFlags+#if __GLASGOW_HASKELL__ < 707 _ <- setSessionDynFlags (f dflags)+#else+ -- GHCi 7.7 now uses dynamic linking.+ let dflags' = case lookup "GHC Dynamic" (compilerInfo dflags) of+ Just "YES" -> gopt_set dflags Opt_BuildDynamicToo+ _ -> dflags+ _ <- setSessionDynFlags (f dflags')+#endif return () withTempOutputDir :: Ghc a -> Ghc a@@ -122,7 +142,9 @@ -- those modules (possibly indirect). extract :: [String] -> IO [Module (Located String)] extract args = do- mods <- parse args+ sandboxArgs <- getSandboxArguments+ let args' = args ++ sandboxArgs+ mods <- parse args' let docs = map (fmap (fmap convertDosLineEndings) . extractFromModule . tm_parsed_module) mods (docs `deepseq` return docs) `catches` [
src/GhcUtil.hs view
@@ -3,16 +3,21 @@ import Control.Exception import GHC.Paths (libdir)+#if __GLASGOW_HASKELL__ < 707 import GHC hiding (flags) import DynFlags (dopt_set)-import Panic (ghcError)+#else+import GHC+import DynFlags (gopt_set)+#endif+import Panic (throwGhcException) import MonadUtils (liftIO) import System.Exit (exitFailure)--#if __GLASGOW_HASKELL__ < 702 import StaticFlags (v_opt_C_ready) import Data.IORef (writeIORef)++#if __GLASGOW_HASKELL__ < 702 #else import StaticFlags (saveStaticFlagGlobals, restoreStaticFlagGlobals) #endif@@ -41,6 +46,7 @@ -- | Run a GHC action in Haddock mode withGhc :: [String] -> ([String] -> Ghc a) -> IO a withGhc flags action = bracketStaticFlags $ do+ writeIORef v_opt_C_ready False flags_ <- handleStaticFlags flags runGhc (Just libdir) $ do@@ -59,11 +65,15 @@ let srcs = map unLoc locSrcs unknown_opts = [ f | f@('-':_) <- srcs ] case unknown_opts of- opt : _ -> ghcError (UsageError ("unrecognized option `"++ opt ++ "'"))+ opt : _ -> throwGhcException (UsageError ("unrecognized option `"++ opt ++ "'")) _ -> return srcs setHaddockMode :: DynFlags -> DynFlags+#if __GLASGOW_HASKELL__ < 707 setHaddockMode dynflags = (dopt_set dynflags Opt_Haddock) {+#else+setHaddockMode dynflags = (gopt_set dynflags Opt_Haddock) {+#endif hscTarget = HscNothing , ghcMode = CompManager , ghcLink = NoLink
src/Interpreter.hs view
@@ -22,6 +22,7 @@ import Data.List import GHC.Paths (ghc)+import Sandbox (getSandboxArguments) -- | Truly random marker, used to separate expressions. --@@ -55,13 +56,22 @@ newInterpreter :: [String] -> IO Interpreter newInterpreter flags = do+ sandboxFlags <- getSandboxArguments+ let myFlags = ghciFlags ++ flags ++ sandboxFlags+ -- get examples from Haddock comments (Just stdin_, Just stdout_, Nothing, processHandle ) <- createProcess $ (proc ghc myFlags) {std_in = CreatePipe, std_out = CreatePipe, std_err = Inherit} setMode stdin_ setMode stdout_ let interpreter = Interpreter {hIn = stdin_, hOut = stdout_, process = processHandle} _ <- eval interpreter "import System.IO" _ <- eval interpreter "import GHC.IO.Handle"+ -- The buffering of stdout and stderr is NoBuffering _ <- eval interpreter "hDuplicateTo stdout stderr"+ -- Now the buffering of stderr is BlockBuffering Nothing+ -- In this situation, GHC 7.7 does not flush the buffer even when+ -- error happens.+ _ <- eval interpreter "hSetBuffering stdout LineBuffering"+ _ <- eval interpreter "hSetBuffering stderr LineBuffering" -- this is required on systems that don't use utf8 as default encoding (e.g. -- Windows)@@ -70,8 +80,7 @@ return interpreter where- myFlags = ["-v0", "--interactive", "-ignore-dot-ghci"] ++ flags-+ ghciFlags = ["-v0", "--interactive", "-ignore-dot-ghci"] setMode handle = do hSetBinaryMode handle False hSetBuffering handle LineBuffering
src/Property.hs view
@@ -67,5 +67,8 @@ extractVariable = unquote . takeWhileEnd (/= ' ') -- | Remove quotes from given name, if any.- unquote ('`':xs) = init xs- unquote xs = xs+ unquote ('`':xs) = init xs+#if __GLASGOW_HASKELL__ >= 707+ unquote ('\8219':xs) = init xs+#endif+ unquote xs = xs
+ src/Sandbox.hs view
@@ -0,0 +1,77 @@+module Sandbox (getSandboxArguments) where++import Control.Applicative ((<$>))+import Data.Char (isSpace)+import Data.List (isPrefixOf, tails)+import System.Directory (getCurrentDirectory, doesFileExist, doesDirectoryExist)+import System.FilePath ((</>), takeDirectory, takeFileName)+import Control.Exception (handle, SomeException)++configFile :: String+configFile = "cabal.sandbox.config"++sandboxDir :: String+sandboxDir = ".cabal-sandbox"++pkgDbKey :: String+pkgDbKey = "package-db:"++pkgDbKeyLen :: Int+pkgDbKeyLen = length pkgDbKey++getSandboxArguments :: IO [String]+getSandboxArguments = do+ mdir <- getCurrentDirectory >>= getSandboxDir+ case mdir of+ Nothing -> return []+ Just (sdir,sconf) -> sandboxArguments sdir sconf++getSandboxDir :: FilePath -> IO (Maybe (FilePath,FilePath))+getSandboxDir dir = do+ exist <- doesSandboxExist dir+ if exist then+ return $ Just (dir </> sandboxDir, dir </> configFile)+ else do+ let dir' = takeDirectory dir+ if dir == dir' then+ return Nothing+ else+ getSandboxDir dir'++doesSandboxExist :: FilePath -> IO Bool+doesSandboxExist dir = do+ fileExist <- doesFileExist $ dir </> configFile+ dirExist <- doesDirectoryExist $ dir </> sandboxDir+ return (fileExist && dirExist)++sandboxArguments :: FilePath -> FilePath -> IO [String]+sandboxArguments sdir sconf = handle handler $ do+ pkgDb <- getPackageDbDir sconf+ let ver = extractGhcVer pkgDb+ let (pkgDbOpt,noUserPkgDbOpt)+ | ver < 706 = ("-package-conf","-no-user-package-conf")+ | otherwise = ("-package-db", "-no-user-package-db")+ pkgDbPath = sdir </> pkgDb+ libPath = sdir </> "lib"+ impOpt = "-i" ++ libPath+ return [noUserPkgDbOpt, pkgDbOpt, pkgDbPath, impOpt]+ where+ handler :: SomeException -> IO [String]+ handler _ = return []++getPackageDbDir :: FilePath -> IO FilePath+getPackageDbDir sconf = do+ ls <- lines <$> readFile sconf+ let [target] = filter ("package-db:" `isPrefixOf`) ls+ return $ extractValue target+ where+ extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen++extractGhcVer :: String -> Int+extractGhcVer dir = ver+ where+ file = takeFileName dir+ findVer = drop 4 . head . filter ("ghc-" `isPrefixOf`) . tails+ (verStr1,_:left) = break (== '.') $ findVer file+ (verStr2,_) = break (== '.') left+ ver = read verStr1 * 100 + read verStr2