Hello community, here is the log from the commit of package ghc-temporary for openSUSE:Factory checked in at 2017-07-05 23:56:14 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-temporary (Old) and /work/SRC/openSUSE:Factory/.ghc-temporary.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-temporary" Wed Jul 5 23:56:14 2017 rev:7 rq:506850 version:1.2.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-temporary/ghc-temporary.changes 2016-07-21 08:17:12.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-temporary.new/ghc-temporary.changes 2017-07-05 23:56:15.458664322 +0200 @@ -1,0 +2,5 @@ +Mon Jun 19 20:53:31 UTC 2017 - [email protected] + +- Update to version 1.2.1. + +------------------------------------------------------------------- Old: ---- temporary-1.2.0.4.tar.gz New: ---- temporary-1.2.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-temporary.spec ++++++ --- /var/tmp/diff_new_pack.RsG05S/_old 2017-07-05 23:56:16.082576434 +0200 +++ /var/tmp/diff_new_pack.RsG05S/_new 2017-07-05 23:56:16.086575871 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-temporary # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -17,16 +17,16 @@ %global pkg_name temporary +%bcond_with tests Name: ghc-%{pkg_name} -Version: 1.2.0.4 +Version: 1.2.1 Release: 0 -Summary: Portable temporary file and directory support for Windows and Unix, based on code from Cabal +Summary: Portable temporary file and directory support License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-directory-devel BuildRequires: ghc-exceptions-devel BuildRequires: ghc-filepath-devel @@ -34,14 +34,14 @@ BuildRequires: ghc-transformers-devel BuildRequires: ghc-unix-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps +%if %{with tests} +BuildRequires: ghc-base-compat-devel +BuildRequires: ghc-tasty-devel +BuildRequires: ghc-tasty-hunit-devel +%endif %description -The functions for creating temporary files and directories in the base library -are quite limited. The unixutils package contains some good ones, but they -aren't portable to Windows. This library just repackages the Cabal -implementations of its own temporary file and folder functions so that you can -use them without linking against Cabal or depending on it being installed. +Functions for creating temporary files and directories. %package devel Summary: Haskell %{pkg_name} library development files @@ -57,14 +57,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install +%check +%cabal_test %post devel %ghc_pkg_recache @@ -78,5 +78,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) +%doc CHANGELOG.md %changelog ++++++ temporary-1.2.0.4.tar.gz -> temporary-1.2.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/temporary-1.2.0.4/CHANGELOG.md new/temporary-1.2.1/CHANGELOG.md --- old/temporary-1.2.0.4/CHANGELOG.md 1970-01-01 01:00:00.000000000 +0100 +++ new/temporary-1.2.1/CHANGELOG.md 2017-06-11 18:56:51.000000000 +0200 @@ -0,0 +1,11 @@ +## 1.2.1 + +* Limit support to GHC 7.0+ +* Add new functions: `writeTempFile,` `writeSystemTempFile,` `emptyTempFile,` `emptySystemTempFile` +* Make sure that system* functions return canonicalized paths +* Modernize the code base, add tests and documentation + +## 1.2.0.4 + +* Update maintainership information +* Fix the docs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/temporary-1.2.0.4/Distribution/Compat/Exception.hs new/temporary-1.2.1/Distribution/Compat/Exception.hs --- old/temporary-1.2.0.4/Distribution/Compat/Exception.hs 2015-09-25 10:16:11.000000000 +0200 +++ new/temporary-1.2.1/Distribution/Compat/Exception.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,49 +0,0 @@ -{-# OPTIONS -cpp #-} --- OPTIONS required for ghc-6.4.x compat, and must appear first -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -cpp #-} -{-# OPTIONS_NHC98 -cpp #-} -{-# OPTIONS_JHC -fcpp #-} - -#if !(defined(__HUGS__) || (defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 610)) -#define NEW_EXCEPTION -#endif - -module Distribution.Compat.Exception - (onException, catchIO, catchExit, throwIOIO) - where - -import System.Exit -import qualified Control.Exception as Exception - -onException :: IO a -> IO b -> IO a -#ifdef NEW_EXCEPTION -onException = Exception.onException -#else -onException io what = io `Exception.catch` \e -> do what - Exception.throw e -#endif - -throwIOIO :: Exception.IOException -> IO a -#ifdef NEW_EXCEPTION -throwIOIO = Exception.throwIO -#else -throwIOIO = Exception.throwIO . Exception.IOException -#endif - -catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a -#ifdef NEW_EXCEPTION -catchIO = Exception.catch -#else -catchIO = Exception.catchJust Exception.ioErrors -#endif - -catchExit :: IO a -> (ExitCode -> IO a) -> IO a -#ifdef NEW_EXCEPTION -catchExit = Exception.catch -#else -catchExit = Exception.catchJust exitExceptions - where exitExceptions (Exception.ExitException ee) = Just ee - exitExceptions _ = Nothing -#endif - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/temporary-1.2.0.4/Distribution/Compat/TempFile.hs new/temporary-1.2.1/Distribution/Compat/TempFile.hs --- old/temporary-1.2.0.4/Distribution/Compat/TempFile.hs 2015-09-25 10:16:11.000000000 +0200 +++ new/temporary-1.2.1/Distribution/Compat/TempFile.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,209 +0,0 @@ -{-# OPTIONS -cpp #-} --- OPTIONS required for ghc-6.4.x compat, and must appear first -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -cpp #-} -{-# OPTIONS_NHC98 -cpp #-} -{-# OPTIONS_JHC -fcpp #-} --- #hide -module Distribution.Compat.TempFile ( - openTempFile, - openBinaryTempFile, - openNewBinaryFile, - createTempDirectory, - ) where - - -import System.FilePath ((</>)) -import Foreign.C (eEXIST) - -#if __NHC__ || __HUGS__ -import System.IO (openFile, openBinaryFile, - Handle, IOMode(ReadWriteMode)) -import System.Directory (doesFileExist) -import System.FilePath ((<.>), splitExtension) -import System.IO.Error (try, isAlreadyExistsError) -#else -import System.IO (Handle, openTempFile, openBinaryTempFile) -import Data.Bits ((.|.)) -import System.Posix.Internals (c_open, c_close, o_CREAT, o_EXCL, o_RDWR, - o_BINARY, o_NONBLOCK, o_NOCTTY) -import System.IO.Error (isAlreadyExistsError) -#if __GLASGOW_HASKELL__ >= 706 -import Control.Exception (try) -#else -import System.IO.Error (try) -#endif -#if __GLASGOW_HASKELL__ >= 611 -import System.Posix.Internals (withFilePath) -#else -import Foreign.C (withCString) -#endif -import Foreign.C (CInt) -#if __GLASGOW_HASKELL__ >= 611 -import GHC.IO.Handle.FD (fdToHandle) -#else -import GHC.Handle (fdToHandle) -#endif -import Distribution.Compat.Exception (onException) -#endif -import Foreign.C (getErrno, errnoToIOError) - -#if __NHC__ -import System.Posix.Types (CPid(..)) -foreign import ccall unsafe "getpid" c_getpid :: IO CPid -#else -import System.Posix.Internals (c_getpid) -#endif - -#ifdef mingw32_HOST_OS -import System.Directory ( createDirectory ) -#else -import qualified System.Posix -#endif - --- ------------------------------------------------------------ --- * temporary files --- ------------------------------------------------------------ - --- This is here for Haskell implementations that do not come with --- System.IO.openTempFile. This includes nhc-1.20, hugs-2006.9. --- TODO: Not sure about jhc - -#if __NHC__ || __HUGS__ --- use a temporary filename that doesn't already exist. --- NB. *not* secure (we don't atomically lock the tmp file we get) -openTempFile :: FilePath -> String -> IO (FilePath, Handle) -openTempFile tmp_dir template - = do x <- getProcessID - findTempName x - where - (templateBase, templateExt) = splitExtension template - findTempName :: Int -> IO (FilePath, Handle) - findTempName x - = do let path = tmp_dir </> (templateBase ++ "-" ++ show x) <.> templateExt - b <- doesFileExist path - if b then findTempName (x+1) - else do hnd <- openFile path ReadWriteMode - return (path, hnd) - -openBinaryTempFile :: FilePath -> String -> IO (FilePath, Handle) -openBinaryTempFile tmp_dir template - = do x <- getProcessID - findTempName x - where - (templateBase, templateExt) = splitExtension template - findTempName :: Int -> IO (FilePath, Handle) - findTempName x - = do let path = tmp_dir </> (templateBase ++ show x) <.> templateExt - b <- doesFileExist path - if b then findTempName (x+1) - else do hnd <- openBinaryFile path ReadWriteMode - return (path, hnd) - -openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle) -openNewBinaryFile = openBinaryTempFile - -getProcessID :: IO Int -getProcessID = fmap fromIntegral c_getpid -#else --- This is a copy/paste of the openBinaryTempFile definition, but --- if uses 666 rather than 600 for the permissions. The base library --- needs to be changed to make this better. -openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle) -openNewBinaryFile dir template = do - pid <- c_getpid - findTempName pid - where - -- We split off the last extension, so we can use .foo.ext files - -- for temporary files (hidden on Unix OSes). Unfortunately we're - -- below filepath in the hierarchy here. - (prefix,suffix) = - case break (== '.') $ reverse template of - -- First case: template contains no '.'s. Just re-reverse it. - (rev_suffix, "") -> (reverse rev_suffix, "") - -- Second case: template contains at least one '.'. Strip the - -- dot from the prefix and prepend it to the suffix (if we don't - -- do this, the unique number will get added after the '.' and - -- thus be part of the extension, which is wrong.) - (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix) - -- Otherwise, something is wrong, because (break (== '.')) should - -- always return a pair with either the empty string or a string - -- beginning with '.' as the second component. - _ -> error "bug in System.IO.openTempFile" - - oflags = rw_flags .|. o_EXCL .|. o_BINARY - -#if __GLASGOW_HASKELL__ < 611 - withFilePath = withCString -#endif - - findTempName x = do - fd <- withFilePath filepath $ \ f -> - c_open f oflags 0o666 - if fd < 0 - then do - errno <- getErrno - if errno == eEXIST - then findTempName (x+1) - else ioError (errnoToIOError "openNewBinaryFile" errno Nothing (Just dir)) - else do - -- TODO: We want to tell fdToHandle what the filepath is, - -- as any exceptions etc will only be able to report the - -- fd currently - h <- -#if __GLASGOW_HASKELL__ >= 609 - fdToHandle fd -#elif __GLASGOW_HASKELL__ <= 606 && defined(mingw32_HOST_OS) - -- fdToHandle is borked on Windows with ghc-6.6.x - openFd (fromIntegral fd) Nothing False filepath - ReadWriteMode True -#else - fdToHandle (fromIntegral fd) -#endif - `onException` c_close fd - return (filepath, h) - where - filename = prefix ++ show x ++ suffix - filepath = dir `combine` filename - - -- FIXME: bits copied from System.FilePath - combine a b - | null b = a - | null a = b - | last a == pathSeparator = a ++ b - | otherwise = a ++ [pathSeparator] ++ b - --- FIXME: Should use filepath library -pathSeparator :: Char -#ifdef mingw32_HOST_OS -pathSeparator = '\\' -#else -pathSeparator = '/' -#endif - --- FIXME: Copied from GHC.Handle -std_flags, output_flags, rw_flags :: CInt -std_flags = o_NONBLOCK .|. o_NOCTTY -output_flags = std_flags .|. o_CREAT -rw_flags = output_flags .|. o_RDWR -#endif - -createTempDirectory :: FilePath -> String -> IO FilePath -createTempDirectory dir template = do - pid <- c_getpid - findTempName pid - where - findTempName x = do - let dirpath = dir </> template ++ show x - r <- try $ mkPrivateDir dirpath - case r of - Right _ -> return dirpath - Left e | isAlreadyExistsError e -> findTempName (x+1) - | otherwise -> ioError e - -mkPrivateDir :: String -> IO () -#ifdef mingw32_HOST_OS -mkPrivateDir s = createDirectory s -#else -mkPrivateDir s = System.Posix.createDirectory s 0o700 -#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/temporary-1.2.0.4/LICENSE new/temporary-1.2.1/LICENSE --- old/temporary-1.2.0.4/LICENSE 2015-09-25 10:16:11.000000000 +0200 +++ new/temporary-1.2.1/LICENSE 2017-06-11 19:04:25.000000000 +0200 @@ -1,4 +1,9 @@ -Copyright (c) 2008, Maximilian Bolingbroke +Copyright + (c) 2003-2006, Isaac Jones + (c) 2005-2009, Duncan Coutts + (c) 2008, Maximilian Bolingbroke + ... and other contributors + All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted @@ -19,4 +24,4 @@ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT -OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file +OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/temporary-1.2.0.4/System/IO/Temp.hs new/temporary-1.2.1/System/IO/Temp.hs --- old/temporary-1.2.0.4/System/IO/Temp.hs 2016-01-24 22:49:53.000000000 +0100 +++ new/temporary-1.2.1/System/IO/Temp.hs 2017-06-11 18:39:36.000000000 +0200 @@ -1,44 +1,65 @@ +{-# LANGUAGE CPP #-} +-- | Functions to create temporary files and directories. +-- +-- Most functions come in two flavours: those that create files/directories +-- under the system standard temporary directory and those that use the +-- user-supplied directory. +-- +-- The functions that create files/directories under the system standard +-- temporary directory will return canonical absolute paths (see +-- 'getCanonicalTemporaryDirectory'). The functions use the user-supplied +-- directory do not canonicalize the returned path. +-- +-- The action inside 'withTempFile' or 'withTempDirectory' is allowed to +-- remove the temporary file/directory if it needs to. module System.IO.Temp ( withSystemTempFile, withSystemTempDirectory, withTempFile, withTempDirectory, - module Distribution.Compat.TempFile + openNewBinaryFile, + createTempDirectory, + writeTempFile, writeSystemTempFile, + emptyTempFile, emptySystemTempFile, + -- * Re-exports from System.IO + openTempFile, + openBinaryTempFile, + -- * Auxiliary functions + getCanonicalTemporaryDirectory ) where --- NB: this module was extracted directly from "Distribution/Simple/Utils.hs" --- in a Cabal tree whose most recent commit was on Sun Oct 10 22:00:26 --- --- The files in the Distribution/Compat tree are exact copies of the corresponding --- file in the Cabal checkout. - - -import Control.Monad.Catch as Exception +import qualified Control.Monad.Catch as MC import Control.Monad.IO.Class import System.Directory -import System.IO - -import Distribution.Compat.TempFile - +import System.IO (Handle, hClose, openTempFile, openBinaryTempFile, + openBinaryTempFileWithDefaultPermissions, hPutStr) +import System.IO.Error (isAlreadyExistsError) +import System.Posix.Internals (c_getpid) +import System.FilePath ((</>)) +#ifdef mingw32_HOST_OS +import System.Directory ( createDirectory ) +#else +import qualified System.Posix +#endif -- | Create and use a temporary file in the system standard temporary directory. -- -- Behaves exactly the same as 'withTempFile', except that the parent temporary directory --- will be that returned by 'getTemporaryDirectory'. -withSystemTempFile :: (MonadIO m, MonadMask m) => +-- will be that returned by 'getCanonicalTemporaryDirectory'. +withSystemTempFile :: (MonadIO m, MC.MonadMask m) => String -- ^ File name template. See 'openTempFile'. -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file -> m a -withSystemTempFile template action = liftIO getTemporaryDirectory >>= \tmpDir -> withTempFile tmpDir template action +withSystemTempFile template action = liftIO getCanonicalTemporaryDirectory >>= \tmpDir -> withTempFile tmpDir template action -- | Create and use a temporary directory in the system standard temporary directory. -- -- Behaves exactly the same as 'withTempDirectory', except that the parent temporary directory --- will be that returned by 'getTemporaryDirectory'. -withSystemTempDirectory :: (MonadIO m, MonadMask m) => +-- will be that returned by 'getCanonicalTemporaryDirectory'. +withSystemTempDirectory :: (MonadIO m, MC.MonadMask m) => String -- ^ Directory name template. See 'openTempFile'. -> (FilePath -> m a) -- ^ Callback that can use the directory -> m a -withSystemTempDirectory template action = liftIO getTemporaryDirectory >>= \tmpDir -> withTempDirectory tmpDir template action +withSystemTempDirectory template action = liftIO getCanonicalTemporaryDirectory >>= \tmpDir -> withTempDirectory tmpDir template action -- | Use a temporary filename that doesn't already exist. @@ -48,15 +69,15 @@ -- -- > withTempFile "src" "sdist." $ \tmpFile hFile -> do ... -- --- The @tmpFlie@ will be file in the given directory, e.g. +-- The @tmpFile@ will be file in the given directory, e.g. -- @src/sdist.342@. -withTempFile :: (MonadIO m, MonadMask m) => +withTempFile :: (MonadIO m, MC.MonadMask m) => FilePath -- ^ Temp dir to create the file in -> String -- ^ File name template. See 'openTempFile'. -> (FilePath -> Handle -> m a) -- ^ Callback that can use the file -> m a withTempFile tmpDir template action = - Exception.bracket + MC.bracket (liftIO (openTempFile tmpDir template)) (\(name, handle) -> liftIO (hClose handle >> ignoringIOErrors (removeFile name))) (uncurry action) @@ -70,15 +91,104 @@ -- -- The @tmpDir@ will be a new subdirectory of the given directory, e.g. -- @src/sdist.342@. -withTempDirectory :: (MonadMask m, MonadIO m) => +withTempDirectory :: (MC.MonadMask m, MonadIO m) => FilePath -- ^ Temp directory to create the directory in -> String -- ^ Directory name template. See 'openTempFile'. -> (FilePath -> m a) -- ^ Callback that can use the directory -> m a withTempDirectory targetDir template = - Exception.bracket + MC.bracket (liftIO (createTempDirectory targetDir template)) (liftIO . ignoringIOErrors . removeDirectoryRecursive) -ignoringIOErrors :: MonadCatch m => m () -> m () -ignoringIOErrors ioe = ioe `Exception.catch` (\e -> const (return ()) (e :: IOError)) + +-- | Create a unique new file, write (text mode) a given data string to it, +-- and close the handle again. The file will not be deleted automatically, +-- and only the current user will have permission to access the file +-- (see `openTempFile` for details). +-- +-- @since 1.2.1 +writeTempFile :: FilePath -- ^ Directory in which to create the file + -> String -- ^ File name template. + -> String -- ^ Data to store in the file. + -> IO FilePath -- ^ Path to the (written and closed) file. +writeTempFile targetDir template content = MC.bracket + (openTempFile targetDir template) + (\(_, handle) -> hClose handle) + (\(filePath, handle) -> hPutStr handle content >> return filePath) + +-- | Like 'writeTempFile', but use the system directory for temporary files. +-- +-- @since 1.2.1 +writeSystemTempFile :: String -- ^ File name template. + -> String -- ^ Data to store in the file. + -> IO FilePath -- ^ Path to the (written and closed) file. +writeSystemTempFile template content + = getCanonicalTemporaryDirectory >>= \tmpDir -> writeTempFile tmpDir template content + +-- | Create a unique new empty file. (Equivalent to 'writeTempFile' with empty data string.) +-- This is useful if the actual content is provided by an external process. +-- +-- @since 1.2.1 +emptyTempFile :: FilePath -- ^ Directory in which to create the file + -> String -- ^ File name template. + -> IO FilePath -- ^ Path to the (written and closed) file. +emptyTempFile targetDir template = MC.bracket + (openTempFile targetDir template) + (\(_, handle) -> hClose handle) + (\(filePath, _) -> return filePath) + +-- | Like 'emptyTempFile', but use the system directory for temporary files. +-- +-- @since 1.2.1 +emptySystemTempFile :: String -- ^ File name template. + -> IO FilePath -- ^ Path to the (written and closed) file. +emptySystemTempFile template + = getCanonicalTemporaryDirectory >>= \tmpDir -> emptyTempFile tmpDir template + + +ignoringIOErrors :: MC.MonadCatch m => m () -> m () +ignoringIOErrors ioe = ioe `MC.catch` (\e -> const (return ()) (e :: IOError)) + +-- | Like 'openBinaryTempFile', but uses 666 rather than 600 for the +-- permissions. +-- +-- Equivalent to 'openBinaryTempFileWithDefaultPermissions'. +openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle) +openNewBinaryFile = openBinaryTempFileWithDefaultPermissions + +-- | Create a temporary directory. See 'withTempDirectory'. +createTempDirectory + :: FilePath -- ^ Temp directory to create the directory in + -> String -- ^ Directory name template + -> IO FilePath +createTempDirectory dir template = do + pid <- c_getpid + findTempName pid + where + findTempName x = do + let dirpath = dir </> template ++ show x + r <- MC.try $ mkPrivateDir dirpath + case r of + Right _ -> return dirpath + Left e | isAlreadyExistsError e -> findTempName (x+1) + | otherwise -> ioError e + +mkPrivateDir :: String -> IO () +#ifdef mingw32_HOST_OS +mkPrivateDir s = createDirectory s +#else +mkPrivateDir s = System.Posix.createDirectory s 0o700 +#endif + +-- | Return the absolute and canonical path to the system temporary +-- directory. +-- +-- >>> setCurrentDirectory "/home/feuerbach/" +-- >>> setEnv "TMPDIR" "." +-- >>> getTemporaryDirectory +-- "." +-- >>> getCanonicalTemporaryDirectory +-- "/home/feuerbach" +getCanonicalTemporaryDirectory :: IO FilePath +getCanonicalTemporaryDirectory = getTemporaryDirectory >>= canonicalizePath diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/temporary-1.2.0.4/temporary.cabal new/temporary-1.2.1/temporary.cabal --- old/temporary-1.2.0.4/temporary.cabal 2016-01-24 23:33:16.000000000 +0100 +++ new/temporary-1.2.1/temporary.cabal 2017-06-11 19:05:52.000000000 +0200 @@ -1,33 +1,48 @@ name: temporary -version: 1.2.0.4 -cabal-version: >= 1.6 -synopsis: Portable temporary file and directory support for Windows and Unix, based on code from Cabal -description: The functions for creating temporary files and directories in the base library are quite limited. The unixutils - package contains some good ones, but they aren't portable to Windows. - - This library just repackages the Cabal implementations of its own temporary file and folder functions so that - you can use them without linking against Cabal or depending on it being installed. +version: 1.2.1 +cabal-version: >= 1.10 +synopsis: Portable temporary file and directory support +description: Functions for creating temporary files and directories. category: System, Utils license: BSD3 license-file: LICENSE -copyright: (c) 2003-2006, Isaac Jones - (c) 2005-2009, Duncan Coutts -author: Isaac Jones <[email protected]> - Duncan Coutts <[email protected]> maintainer: Mateusz Kowalczyk <[email protected]>, Roman Cheplyaka <[email protected]> -homepage: http://www.github.com/feuerbach/temporary +homepage: https://github.com/feuerbach/temporary build-type: Simple +extra-source-files: CHANGELOG.md source-repository head type: git location: git://github.com/feuerbach/temporary.git Library + default-language: + Haskell2010 exposed-modules: System.IO.Temp - other-modules: Distribution.Compat.Exception - Distribution.Compat.TempFile build-depends: base >= 3 && < 10, filepath >= 1.1, directory >= 1.0, transformers >= 0.2.0.0, exceptions >= 0.6 + ghc-options: -Wall if !os(windows) build-depends: unix >= 2.3 + +test-suite test + default-language: + Haskell2010 + type: + exitcode-stdio-1.0 + hs-source-dirs: + tests + main-is: + test.hs + ghc-options: -threaded -with-rtsopts=-N2 + build-depends: + base >= 4.3 && < 5 + , directory + , tasty + , tasty-hunit + , temporary + , filepath + , base-compat + if !os(windows) + build-depends: unix >= 2.3 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/temporary-1.2.0.4/tests/test.hs new/temporary-1.2.1/tests/test.hs --- old/temporary-1.2.0.4/tests/test.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/temporary-1.2.1/tests/test.hs 2017-06-11 18:50:53.000000000 +0200 @@ -0,0 +1,111 @@ +{-# LANGUAGE CPP #-} +import Test.Tasty +import Test.Tasty.HUnit + +import Control.Monad +import Control.Concurrent +import Control.Concurrent.MVar +import Control.Exception +import System.Directory +import System.IO +import System.FilePath +import System.Environment.Compat +import Data.Bits +import Data.List +import GHC.IO.Handle +#ifndef mingw32_HOST_OS +import System.Posix.Files +#endif + +import System.IO.Temp + +main = do + -- force single-thread execution, because changing TMPDIR in one of the + -- tests may leak to the other tests + setEnv "TASTY_NUM_THREADS" "1" +#ifndef mingw32_HOST_OS + setFileCreationMask 0 +#endif + sys_tmp_dir <- getCanonicalTemporaryDirectory + + defaultMain $ testGroup "Tests" + [ testCase "openNewBinaryFile" $ do + (fp, fh) <- openNewBinaryFile sys_tmp_dir "test.txt" + let fn = takeFileName fp + assertBool ("Does not match template: " ++ fn) $ + ("test" `isPrefixOf` fn) && (".txt" `isSuffixOf` fn) + assertBool (fp ++ " is not in the right directory " ++ sys_tmp_dir) $ + takeDirectory fp `equalFilePath` sys_tmp_dir + hClose fh + assertBool "File does not exist" =<< doesFileExist fp +#ifndef mingw32_HOST_OS + status <- getFileStatus fp + fileMode status .&. 0o777 @?= 0o666 +#endif + removeFile fp + , testCase "withSystemTempFile" $ do + (fp, fh) <- withSystemTempFile "test.txt" $ \fp fh -> do + let fn = takeFileName fp + assertBool ("Does not match template: " ++ fn) $ + ("test" `isPrefixOf` fn) && (".txt" `isSuffixOf` fn) + assertBool (fp ++ " is not in the right directory " ++ sys_tmp_dir) $ + takeDirectory fp `equalFilePath` sys_tmp_dir + assertBool "File not open" =<< hIsOpen fh + hPutStrLn fh "hi" + assertBool "File does not exist" =<< doesFileExist fp +#ifndef mingw32_HOST_OS + status <- getFileStatus fp + fileMode status .&. 0o777 @?= 0o600 +#endif + return (fp, fh) + assertBool "File still exists" . not =<< doesFileExist fp + assertBool "File not closed" =<< hIsClosed fh + , testCase "withSystemTempDirectory" $ do + fp <- withSystemTempDirectory "test.dir" $ \fp -> do + let fn = takeFileName fp + assertBool ("Does not match template: " ++ fn) $ + ("test.dir" `isPrefixOf` fn) + assertBool (fp ++ " is not in the right directory " ++ sys_tmp_dir) $ + takeDirectory fp `equalFilePath` sys_tmp_dir + assertBool "Directory does not exist" =<< doesDirectoryExist fp +#ifndef mingw32_HOST_OS + status <- getFileStatus fp + fileMode status .&. 0o777 @?= 0o700 +#endif + return fp + assertBool "Directory still exists" . not =<< doesDirectoryExist fp + , testCase "writeSystemTempFile" $ do + fp <- writeSystemTempFile "blah.txt" "hello" + str <- readFile fp + "hello" @?= str + removeFile fp + , testCase "emptySystemTempFile" $ do + fp <- emptySystemTempFile "empty.txt" + assertBool "File doesn't exist" =<< doesFileExist fp + removeFile fp + , testCase "withSystemTempFile returns absolute path" $ do + bracket_ (setEnv "TMPDIR" ".") (unsetEnv "TMPDIR") $ do + withSystemTempFile "temp.txt" $ \fp _ -> + assertBool "Not absolute" $ isAbsolute fp + , testCase "withSystemTempDirectory is not interrupted" $ do + -- this mvar is both a channel to pass the name of the directory + -- and a signal that we finished creating files and are ready + -- to be killed + mvar1 <- newEmptyMVar + -- this mvar signals that the withSystemTempDirectory function + -- returned and we can check whether the directory has survived + mvar2 <- newEmptyMVar + threadId <- forkIO $ + (withSystemTempDirectory "temp.test." $ \dir -> do + replicateM_ 100 $ emptyTempFile dir "file.xyz" + putMVar mvar1 dir + threadDelay $ 10^6 + ) `finally` (putMVar mvar2 ()) + dir <- readMVar mvar1 + -- start sending exceptions + replicateM_ 10 $ forkIO $ killThread threadId + -- wait for the thread to finish + readMVar mvar2 + -- check whether the directory was successfully removed + assertBool "Directory was not removed" . not =<< doesDirectoryExist dir + ]
