Avoid directory in tests

System/File/OsPath.hs

@@ -27,6 +27,7 @@ module System.File.OsPath (
 , openBinaryTempFile
 , openTempFileWithDefaultPermissions
 , openBinaryTempFileWithDefaultPermissions
+, createTempDirectory
 ) where
 
 

System/File/OsPath/Internal.hs

@@ -162,6 +162,18 @@ openTempFile :: OsPath     -- ^ Directory in which to create the file
              -> IO (OsPath, Handle)
 openTempFile tmp_dir template = openTempFile' "openTempFile" tmp_dir template False 0o600
 
+-- | The function creates a temporary directory.
+--
+-- @since 0.1.6
+createTempDirectory :: OsPath     -- ^ Directory in which to create the file
+                    -> OsString   -- ^ Directory name template. If the template is \"foo\" then
+                                  -- the created directory will be \"fooXXX\" where XXX is some
+                                  -- random number. Note that this should not contain any path
+                                  -- separator characters. On Windows, the template may
+                                  -- be truncated to 3 chars.
+                    -> IO OsPath
+createTempDirectory tmp_dir template = createTempDirectory' "createTempDirectory" tmp_dir template 0o700
+
 -- | Like 'openTempFile', but opens the file in binary mode. See 'openBinaryFile' for more comments.
 --
 -- @since 0.1.3
@@ -247,6 +259,15 @@ openTempFile' loc (OsString tmp_dir) template@(OsString tmpl) binary mode
     -- below filepath in the hierarchy here.
     (OsString prefix, OsString suffix) = OSP.splitExtension template
 
+createTempDirectory' :: String -> OsPath -> OsString -> CMode
+                     -> IO OsPath
+createTempDirectory' loc (OsString tmp_dir) template@(OsString tmpl) mode
+    | any_ (== OSP.pathSeparator) template
+    = throwIO $ userError $ "createTempDirectory': Template string must not contain path separator characters: " ++ P.lenientDecode tmpl
+    | otherwise = do
+        fp <- P.findTempDName tmpl loc tmp_dir mode
+        pure (OsString fp)
+
 #if MIN_VERSION_filepath(1, 5, 0)
 any_ :: (OsChar -> Bool) -> OsString -> Bool
 any_ = OSS.any

file-io.cabal

@@ -61,56 +61,71 @@ library
 
   ghc-options:      -Wall
 
+
+common test-utils
+    other-modules: TestUtils
+    build-depends: os-string
+    if os(windows)
+      build-depends: Win32 >=2.13.3.0
+    else
+      build-depends: unix >=2.8.0.0 && <3
+
 test-suite T15
+    import: test-utils
     hs-source-dirs: tests
     main-is: T15.hs
     type: exitcode-stdio-1.0
     default-language: Haskell2010
-    build-depends: base >=4.13.0.0 && <5, tasty, tasty-hunit, file-io, filepath, temporary
+    build-depends: base >=4.13.0.0 && <5, tasty, tasty-hunit, file-io, filepath
     ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N10"
     if os(windows)
       build-depends: Win32 >=2.13.3.0
 
 test-suite T15Win
+    import: test-utils
     hs-source-dirs: tests
     main-is: T15Win.hs
     type: exitcode-stdio-1.0
     default-language: Haskell2010
     if os(windows)
-      build-depends: base >=4.13.0.0 && <5, tasty, tasty-hunit, file-io, filepath, temporary, Win32 >=2.13.3.0
+      build-depends: base >=4.13.0.0 && <5, tasty, tasty-hunit, file-io, filepath, Win32 >=2.13.3.0
     else
-      build-depends: base >=4.13.0.0 && <5
+      build-depends: base >=4.13.0.0 && <5, filepath, file-io
     ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N10"
 
 test-suite T14
+    import: test-utils
     hs-source-dirs: tests
     main-is: T14.hs
     type: exitcode-stdio-1.0
     default-language: Haskell2010
-    build-depends: base >=4.13.0.0 && <5, file-io, filepath, temporary
+    build-depends: base >=4.13.0.0 && <5, file-io, filepath
     ghc-options: -Wall
 
 test-suite T8
+    import: test-utils
     hs-source-dirs: tests
     main-is: T8.hs
     type: exitcode-stdio-1.0
     default-language: Haskell2010
-    build-depends: base >=4.13.0.0 && <5, bytestring, file-io, filepath, temporary
+    build-depends: base >=4.13.0.0 && <5, bytestring, file-io, filepath
     ghc-options: -Wall -threaded
 
 test-suite CLC237
+    import: test-utils
     hs-source-dirs: tests
     main-is: CLC237.hs
     type: exitcode-stdio-1.0
     default-language: Haskell2010
-    build-depends: base >=4.13.0.0 && <5, file-io, filepath, temporary
+    build-depends: base >=4.13.0.0 && <5, file-io, filepath
     ghc-options: -Wall
 
 test-suite Properties
+    import: test-utils
     hs-source-dirs: tests
     main-is: Properties.hs
     type: exitcode-stdio-1.0
     default-language: Haskell2010
-    build-depends: base >=4.13.0.0 && <5, bytestring, tasty, tasty-hunit, file-io, filepath, temporary
+    build-depends: base >=4.13.0.0 && <5, bytestring, tasty, tasty-hunit, file-io, filepath
     ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-N10"
 

posix/System/File/Platform.hs

@@ -20,7 +20,9 @@ import System.OsPath.Posix ( PosixPath, PosixString, (</>) )
 import qualified System.OsPath.Posix as PS
 import Data.IORef (IORef, newIORef)
 import System.Posix (CMode)
+import System.Posix.Directory.PosixPath (createDirectory)
 import System.IO (utf8, latin1)
+import System.IO.Error (isAlreadyExistsError)
 import System.IO.Unsafe (unsafePerformIO)
 import System.Posix.Internals (c_getpid)
 import GHC.IORef (atomicModifyIORef'_)
@@ -102,6 +104,23 @@ findTempName (prefix, suffix) loc tmp_dir mode = go
   openTempFile_ :: PosixPath -> CMode -> IO Fd
   openTempFile_ fp cmode = openFd fp ReadWrite defaultFileFlags' { creat = Just cmode, nonBlock = True, noctty = True, exclusive = True }
 
+findTempDName :: PosixString
+              -> String
+              -> PosixPath
+              -> CMode
+              -> IO PosixPath
+findTempDName template _loc tmp_dir mode = go
+ where
+  go = do
+    rs <- rand_string
+    let dirname = template <> rs
+        dirpath = tmp_dir </> dirname
+    r <- try $ createDirectory dirpath mode
+    case r of
+      Right _ -> return dirpath
+      Left e | isAlreadyExistsError e -> go
+             | otherwise -> ioError e
+
 tempCounter :: IORef Int
 tempCounter = unsafePerformIO $ newIORef 0
 {-# NOINLINE tempCounter #-}

tests/CLC237.hs

@@ -10,13 +10,12 @@ import qualified System.OsPath as OSP
 import qualified System.File.OsPath as OSP
 import GHC.IO.Exception (IOErrorType(..), IOException(..))
 import System.IO
-import System.IO.Temp
+import TestUtils
 
 -- Test that the action in 'withFile' does not inherit the filepath annotation
 -- See https://github.com/haskell/core-libraries-committee/issues/237
 main :: IO ()
-main = withSystemTempDirectory "tar-test" $ \baseDir' -> do
-  baseDir <- OSP.encodeFS baseDir'
+main = withFileIOTestDir $ \baseDir-> do
   res <- try @IOException $ OSP.withFile (baseDir </> [osp|foo|]) WriteMode $ \_ -> fail "test"
   case res of
     Left (IOError Nothing UserError "" "test" Nothing Nothing) -> pure ()