diff --git a/lib/hssystemfileio-win32.c b/lib/hssystemfileio-win32.c --- a/lib/hssystemfileio-win32.c +++ b/lib/hssystemfileio-win32.c @@ -1,3 +1,23 @@ +/* +Before including anything, we need to fix up MinGW's MSVCRT defines. + +MinGW's requires __MSVCRT_VERSION__ >= 0x0601 to define +_wstat64(). This is fine for the MinGW distributed with GHC, which sets +__MSVCRT_VERSION__ = 0x0700, but fails for the Haskell Platform because +its MinGW sets __MSVCRT_VERSION__ = 0x0600. + +Therefore, we include <_mingw.h> first and bump its MSVCRT if necessary. +*/ +#include <_mingw.h> + +#if defined(__MSVCRT_VERSION__) +# if __MSVCRT_VERSION__ < 0x0601 +# define __MSVCRT_VERSION__ 0x0601 +# endif +#else +# define __MSVCRT_VERSION__ 0x0601 +#endif + #include "hssystemfileio-win32.h" #include @@ -7,7 +27,7 @@ int hssystemfileio_copy_permissions(const wchar_t *old_path, const wchar_t *new_path) { - struct _stat64 st; + struct __stat64 st; int rc = _wstat64(old_path, &st); if (rc == -1) { return rc; } diff --git a/scripts/common.bash b/scripts/common.bash deleted file mode 100644 --- a/scripts/common.bash +++ /dev/null @@ -1,23 +0,0 @@ -PATH="$PATH:$PWD/cabal-dev/bin/" - -VERSION=$(awk '/^version:/{print $2}' system-fileio.cabal) - -CABAL_DEV=$(which cabal-dev) -XZ=$(which xz) - -require_cabal_dev() -{ - if [ -z "$CABAL_DEV" ]; then - echo "Can't find 'cabal-dev' executable; make sure it exists on your "'$PATH' - echo "Cowardly refusing to fuck with the global package database" - exit 1 - fi -} - -clean_dev_install() -{ - require_cabal_dev - - rm -rf dist - $CABAL_DEV install || exit 1 -} diff --git a/scripts/run-coverage b/scripts/run-coverage deleted file mode 100644 --- a/scripts/run-coverage +++ /dev/null @@ -1,28 +0,0 @@ -#!/bin/bash -if [ ! -f 'system-fileio.cabal' ]; then - echo -n "Can't find system-fileio.cabal; please run this script as" - echo -n " ./scripts/run-coverage from within the system-fileio source" - echo " directory" - exit 1 -fi - -. scripts/common.bash - -require_cabal_dev - -pushd tests -$CABAL_DEV -s ../cabal-dev install --flags="coverage" || exit 1 -popd - -rm -f system-fileio_tests.tix -cabal-dev/bin/system-fileio_tests $@ - -EXCLUDES="\ ---exclude=Main \ ---exclude=FilesystemTests.Posix \ ---exclude=FilesystemTests.Util \ ---exclude=FilesystemTests.Windows -" - -hpc markup --srcdir=src --srcdir=tests/ system-fileio_tests.tix --destdir=hpc-markup $EXCLUDES > /dev/null -hpc report --srcdir=src --srcdir=tests/ system-fileio_tests.tix $EXCLUDES diff --git a/scripts/run-tests b/scripts/run-tests deleted file mode 100644 --- a/scripts/run-tests +++ /dev/null @@ -1,17 +0,0 @@ -#!/bin/bash -if [ ! -f 'system-fileio.cabal' ]; then - echo -n "Can't find system-fileio.cabal; please run this script as" - echo -n " ./scripts/run-tests from within the system-fileio source" - echo " directory" - exit 1 -fi - -. scripts/common.bash - -require_cabal_dev - -pushd tests -$CABAL_DEV -s ../cabal-dev install || exit 1 -popd - -cabal-dev/bin/system-fileio_tests $@ diff --git a/system-fileio.cabal b/system-fileio.cabal --- a/system-fileio.cabal +++ b/system-fileio.cabal @@ -1,11 +1,11 @@ name: system-fileio -version: 0.3.13 +version: 0.3.14 license: MIT license-file: license.txt author: John Millikin maintainer: John Millikin build-type: Simple -cabal-version: >= 1.6 +cabal-version: >= 1.8 category: System stability: experimental homepage: https://john-millikin.com/software/haskell-filesystem/ @@ -25,10 +25,6 @@ lib/hssystemfileio-unix.h lib/hssystemfileio-win32.h -- - scripts/common.bash - scripts/run-coverage - scripts/run-tests - -- tests/system-fileio-tests.cabal tests/FilesystemTests.hs tests/FilesystemTests/Posix.hs @@ -42,7 +38,7 @@ source-repository this type: git location: https://john-millikin.com/code/haskell-filesystem/ - tag: system-fileio_0.3.13 + tag: system-fileio_0.3.14 library ghc-options: -Wall -O2 @@ -70,3 +66,36 @@ exposed-modules: Filesystem + +test-suite filesystem_tests + type: exitcode-stdio-1.0 + main-is: FilesystemTests.hs + + ghc-options: -Wall -O2 + cc-options: -Wall + hs-source-dirs: tests + + build-depends: + base >= 4.0 && < 5.0 + , bytestring >= 0.9 + , chell >= 0.4 && < 0.5 + , system-fileio + , system-filepath + , temporary >= 1.1 && < 2.0 + , text + , time >= 1.0 && < 1.5 + , transformers >= 0.2 + + if os(windows) + cpp-options: -DCABAL_OS_WINDOWS + else + build-depends: + unix >= 2.3 + + if os(darwin) + cpp-options: -DCABAL_OS_DARWIN + + other-modules: + FilesystemTests.Posix + FilesystemTests.Util + FilesystemTests.Windows diff --git a/tests/FilesystemTests.hs b/tests/FilesystemTests.hs --- a/tests/FilesystemTests.hs +++ b/tests/FilesystemTests.hs @@ -14,9 +14,9 @@ import Test.Chell #ifdef CABAL_OS_WINDOWS -import FilesystemTests.Windows (test_Windows) +import FilesystemTests.Windows (suite_Windows) #else -import FilesystemTests.Posix (test_Posix) +import FilesystemTests.Posix (suite_Posix) #endif main :: IO () @@ -24,7 +24,7 @@ tests :: [Suite] #ifdef CABAL_OS_WINDOWS -tests = [test_Windows] +tests = [suite_Windows] #else -tests = [test_Posix] +tests = [suite_Posix] #endif diff --git a/tests/FilesystemTests/Posix.hs b/tests/FilesystemTests/Posix.hs --- a/tests/FilesystemTests/Posix.hs +++ b/tests/FilesystemTests/Posix.hs @@ -7,7 +7,7 @@ -- -- See license.txt for details module FilesystemTests.Posix - ( test_Posix + ( suite_Posix ) where import Prelude hiding (FilePath) @@ -40,212 +40,256 @@ import FilesystemTests.Util (assertionsWithTemp, todo) -test_Posix :: Suite -test_Posix = suite "posix" - [ suite "isFile" - [ test_IsFile "ascii" - (decode "test.txt") - , test_IsFile "utf8" - (fromText "\xA1\xA2.txt") - , test_IsFile "iso8859" - (decode "\xA1\xA2\xA3.txt") - , suite "pipe" - [ test_PipeIsFile "ascii" - (decode "test.txt") - , test_PipeIsFile "utf8" - (fromText "\xA1\xA2.txt") - , test_PipeIsFile "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - ] - , suite "isDirectory" - [ test_IsDirectory "ascii" - (decode "test.d") - , test_IsDirectory "utf8" - (fromText "\xA1\xA2.d") - , test_IsDirectory "iso8859" - (decode "\xA1\xA2\xA3.d") - ] - , suite "rename" - [ test_Rename "ascii" - (decode "old_test.txt") - (decode "new_test.txt") - , test_Rename "utf8" - (fromText "old_\xA1\xA2.txt") - (fromText "new_\xA1\xA2.txt") - , test_Rename "iso8859" - (decode "old_\xA1\xA2\xA3.txt") - (decode "new_\xA1\xA2\xA3.txt") - ] - , suite "canonicalizePath" - [ test_CanonicalizePath "ascii" - (decode "test-a.txt") - (decode "test-b.txt") - , test_CanonicalizePath "utf8" - (fromText "\xA1\xA2-a.txt") - (fromText "\xA1\xA2-b.txt") - , test_CanonicalizePath "iso8859" - (decode "\xA1\xA2\xA3-a.txt") -#ifdef CABAL_OS_DARWIN - (decode "%A1%A2%A3-b.txt") -#else - (decode "\xA1\xA2\xA3-b.txt") -#endif - , test_CanonicalizePath_TrailingSlash - ] - , suite "createDirectory" - [ test_CreateDirectory "ascii" - (decode "test.d") - , test_CreateDirectory "utf8" - (fromText "\xA1\xA2.d") - , test_CreateDirectory "iso8859" - (decode "\xA1\xA2\xA3.d") - , test_CreateDirectory_FailExists - , test_CreateDirectory_SucceedExists - , test_CreateDirectory_FailFileExists - ] - , suite "createTree" - [ test_CreateTree "ascii" - (decode "test.d") - , test_CreateTree "ascii-slash" - (decode "test.d/") - , test_CreateTree "utf8" - (fromText "\xA1\xA2.d") - , test_CreateTree "utf8-slash" - (fromText "\xA1\xA2.d/") - , test_CreateTree "iso8859" - (decode "\xA1\xA2\xA3.d") - , test_CreateTree "iso8859-slash" - (decode "\xA1\xA2\xA3.d/") - ] - , test_ListDirectory - , suite "removeFile" - [ test_RemoveFile "ascii" - (decode "test.txt") - , test_RemoveFile "utf8" - (fromText "\xA1\xA2.txt") - , test_RemoveFile "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - , suite "removeDirectory" - [ test_RemoveDirectory "ascii" - (decode "test.d") - , test_RemoveDirectory "utf8" - (fromText "\xA1\xA2.d") - , test_RemoveDirectory "iso8859" - (decode "\xA1\xA2\xA3.d") - ] - , suite "removeTree" - [ test_RemoveTree "ascii" - (decode "test.d") - , test_RemoveTree "utf8" - (fromText "\xA1\xA2.d") - , test_RemoveTree "iso8859" - (decode "\xA1\xA2\xA3.d") - ] - , suite "getWorkingDirectory" - [ test_GetWorkingDirectory "ascii" - (decode "test.d") - , test_GetWorkingDirectory "utf8" - (fromText "\xA1\xA2.d") - , test_GetWorkingDirectory "iso8859" - (decode "\xA1\xA2\xA3.d") - ] - , suite "setWorkingDirectory" - [ test_SetWorkingDirectory "ascii" - (decode "test.d") - , test_SetWorkingDirectory "utf8" - (fromText "\xA1\xA2.d") - , test_SetWorkingDirectory "iso8859" - (decode "\xA1\xA2\xA3.d") - ] - , suite "getHomeDirectory" - [ test_GetHomeDirectory "ascii" - (decode "/home/test.d") - , test_GetHomeDirectory "utf8" - (decode "/home/\xA1\xA2.d") - , test_GetHomeDirectory "iso8859" - (decode "/home/\xA1\xA2\xA3.d") - ] - , suite "getDesktopDirectory" - [ test_GetDesktopDirectory "ascii" - (decode "/desktop/test.d") - , test_GetDesktopDirectory "utf8" - (decode "/desktop/\xA1\xA2.d") - , test_GetDesktopDirectory "iso8859" - (decode "/desktop/\xA1\xA2\xA3.d") - ] +suite_Posix :: Suite +suite_Posix = suite "posix" $ + (concatMap suiteTests + [ suite_IsFile + , suite_IsDirectory + , suite_Rename + , suite_CanonicalizePath + , suite_CreateDirectory + , suite_CreateTree + , suite_RemoveFile + , suite_RemoveDirectory + , suite_RemoveTree + , suite_GetWorkingDirectory + , suite_SetWorkingDirectory + , suite_GetHomeDirectory + , suite_GetDesktopDirectory + , suite_GetModified + , suite_GetSize + , suite_CopyFile + , suite_WithFile + , suite_WithTextFile + , suite_RegressionTests + ]) ++ + [ test_ListDirectory , todo "getDocumentsDirectory" , todo "getAppDataDirectory" , todo "getAppCacheDirectory" , todo "getAppConfigDirectory" - , suite "getModified" - [ test_GetModified "ascii" - (decode "test.txt") - , test_GetModified "utf8" - (fromText "\xA1\xA2.txt") - , test_GetModified "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - , suite "getSize" - [ test_GetSize "ascii" - (decode "test.txt") - , test_GetSize "utf8" - (fromText "\xA1\xA2.txt") - , test_GetSize "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - , suite "copyFile" - [ test_CopyFile "ascii" - (decode "old_test.txt") - (decode "new_test.txt") - , test_CopyFile "utf8" - (fromText "old_\xA1\xA2.txt") - (fromText "new_\xA1\xA2.txt") - , test_CopyFile "iso8859" - (decode "old_\xA1\xA2\xA3.txt") - (decode "new_\xA1\xA2\xA3.txt") - ] , todo "openFile" - , suite "withFile" - [ suite "read" - [ test_WithFile_Read "ascii" - (decode "test.txt") - , test_WithFile_Read "utf8" - (fromText "\xA1\xA2.txt") - , test_WithFile_Read "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - , suite "write" - [ test_WithFile_Write "ascii" - (decode "test.txt") - , test_WithFile_Write "utf8" - (fromText "\xA1\xA2.txt") - , test_WithFile_Write "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] - ] , todo "readFile" , todo "writeFile" , todo "appendFile" , todo "openTextFile" - , suite "withTextFile" - [ test_WithTextFile "ascii" - (decode "test.txt") - , test_WithTextFile "utf8" - (fromText "\xA1\xA2.txt") - , test_WithTextFile "iso8859" - (decode "\xA1\xA2\xA3.txt") - ] , todo "readTextFile" , todo "writeTextFile" , todo "appendTextFile" - , suite "regression-tests" - [ test_ListDirectoryLeaksFds - ] ] -test_IsFile :: Text -> FilePath -> Suite +suite_IsFile :: Suite +suite_IsFile = suite "isFile" + [ test_IsFile "ascii" (decode "test.txt") + , test_IsFile "utf8" (fromText "\xA1\xA2.txt") + , test_IsFile "iso8859" (decode "\xA1\xA2\xA3.txt") + , test_PipeIsFile "pipe.ascii" (decode "test.txt") + , test_PipeIsFile "pipe.utf8" (fromText "\xA1\xA2.txt") + , test_PipeIsFile "pipe.iso8859" (decode "\xA1\xA2\xA3.txt") + ] + +suite_IsDirectory :: Suite +suite_IsDirectory = suite "isDirectory" + [ test_IsDirectory "ascii" (decode "test.d") + , test_IsDirectory "utf8" (fromText "\xA1\xA2.d") + , test_IsDirectory "iso8859" (decode "\xA1\xA2\xA3.d") + ] + +suite_Rename :: Suite +suite_Rename = suite "rename" + [ test_Rename "ascii" + (decode "old_test.txt") + (decode "new_test.txt") + , test_Rename "utf8" + (fromText "old_\xA1\xA2.txt") + (fromText "new_\xA1\xA2.txt") + , test_Rename "iso8859" + (decode "old_\xA1\xA2\xA3.txt") + (decode "new_\xA1\xA2\xA3.txt") + ] + +suite_CanonicalizePath :: Suite +suite_CanonicalizePath = suite "canonicalizePath" + [ test_CanonicalizePath "ascii" + (decode "test-a.txt") + (decode "test-b.txt") + , test_CanonicalizePath "utf8" + (fromText "\xA1\xA2-a.txt") + (fromText "\xA1\xA2-b.txt") + , test_CanonicalizePath "iso8859" + (decode "\xA1\xA2\xA3-a.txt") +#ifdef CABAL_OS_DARWIN + (decode "%A1%A2%A3-b.txt") +#else + (decode "\xA1\xA2\xA3-b.txt") +#endif + , test_CanonicalizePath_TrailingSlash + ] + +suite_CreateDirectory :: Suite +suite_CreateDirectory = suite "createDirectory" + [ test_CreateDirectory "ascii" + (decode "test.d") + , test_CreateDirectory "utf8" + (fromText "\xA1\xA2.d") + , test_CreateDirectory "iso8859" + (decode "\xA1\xA2\xA3.d") + , test_CreateDirectory_FailExists + , test_CreateDirectory_SucceedExists + , test_CreateDirectory_FailFileExists + ] + +suite_CreateTree :: Suite +suite_CreateTree = suite "createTree" + [ test_CreateTree "ascii" + (decode "test.d") + , test_CreateTree "ascii-slash" + (decode "test.d/") + , test_CreateTree "utf8" + (fromText "\xA1\xA2.d") + , test_CreateTree "utf8-slash" + (fromText "\xA1\xA2.d/") + , test_CreateTree "iso8859" + (decode "\xA1\xA2\xA3.d") + , test_CreateTree "iso8859-slash" + (decode "\xA1\xA2\xA3.d/") + ] + +suite_RemoveFile :: Suite +suite_RemoveFile = suite "removeFile" + [ test_RemoveFile "ascii" + (decode "test.txt") + , test_RemoveFile "utf8" + (fromText "\xA1\xA2.txt") + , test_RemoveFile "iso8859" + (decode "\xA1\xA2\xA3.txt") + ] + +suite_RemoveDirectory :: Suite +suite_RemoveDirectory = suite "removeDirectory" + [ test_RemoveDirectory "ascii" + (decode "test.d") + , test_RemoveDirectory "utf8" + (fromText "\xA1\xA2.d") + , test_RemoveDirectory "iso8859" + (decode "\xA1\xA2\xA3.d") + ] + +suite_RemoveTree :: Suite +suite_RemoveTree = suite "removeTree" + [ test_RemoveTree "ascii" + (decode "test.d") + , test_RemoveTree "utf8" + (fromText "\xA1\xA2.d") + , test_RemoveTree "iso8859" + (decode "\xA1\xA2\xA3.d") + ] + +suite_GetWorkingDirectory :: Suite +suite_GetWorkingDirectory = suite "getWorkingDirectory" + [ test_GetWorkingDirectory "ascii" + (decode "test.d") + , test_GetWorkingDirectory "utf8" + (fromText "\xA1\xA2.d") + , test_GetWorkingDirectory "iso8859" + (decode "\xA1\xA2\xA3.d") + ] + +suite_SetWorkingDirectory :: Suite +suite_SetWorkingDirectory = suite "setWorkingDirectory" + [ test_SetWorkingDirectory "ascii" + (decode "test.d") + , test_SetWorkingDirectory "utf8" + (fromText "\xA1\xA2.d") + , test_SetWorkingDirectory "iso8859" + (decode "\xA1\xA2\xA3.d") + ] + +suite_GetHomeDirectory :: Suite +suite_GetHomeDirectory = suite "getHomeDirectory" + [ test_GetHomeDirectory "ascii" + (decode "/home/test.d") + , test_GetHomeDirectory "utf8" + (decode "/home/\xA1\xA2.d") + , test_GetHomeDirectory "iso8859" + (decode "/home/\xA1\xA2\xA3.d") + ] + +suite_GetDesktopDirectory :: Suite +suite_GetDesktopDirectory = suite "getDesktopDirectory" + [ test_GetDesktopDirectory "ascii" + (decode "/desktop/test.d") + , test_GetDesktopDirectory "utf8" + (decode "/desktop/\xA1\xA2.d") + , test_GetDesktopDirectory "iso8859" + (decode "/desktop/\xA1\xA2\xA3.d") + ] + +suite_GetModified :: Suite +suite_GetModified = suite "getModified" + [ test_GetModified "ascii" + (decode "test.txt") + , test_GetModified "utf8" + (fromText "\xA1\xA2.txt") + , test_GetModified "iso8859" + (decode "\xA1\xA2\xA3.txt") + ] + +suite_GetSize :: Suite +suite_GetSize = suite "getSize" + [ test_GetSize "ascii" + (decode "test.txt") + , test_GetSize "utf8" + (fromText "\xA1\xA2.txt") + , test_GetSize "iso8859" + (decode "\xA1\xA2\xA3.txt") + ] + +suite_CopyFile :: Suite +suite_CopyFile = suite "copyFile" + [ test_CopyFile "ascii" + (decode "old_test.txt") + (decode "new_test.txt") + , test_CopyFile "utf8" + (fromText "old_\xA1\xA2.txt") + (fromText "new_\xA1\xA2.txt") + , test_CopyFile "iso8859" + (decode "old_\xA1\xA2\xA3.txt") + (decode "new_\xA1\xA2\xA3.txt") + ] + +suite_WithFile :: Suite +suite_WithFile = suite "withFile" + [ test_WithFile_Read "read.ascii" + (decode "test.txt") + , test_WithFile_Read "read.utf8" + (fromText "\xA1\xA2.txt") + , test_WithFile_Read "read.iso8859" + (decode "\xA1\xA2\xA3.txt") + , test_WithFile_Write "write.ascii" + (decode "test.txt") + , test_WithFile_Write "write.utf8" + (fromText "\xA1\xA2.txt") + , test_WithFile_Write "write.iso8859" + (decode "\xA1\xA2\xA3.txt") + ] + +suite_WithTextFile :: Suite +suite_WithTextFile = suite "withTextFile" + [ test_WithTextFile "ascii" + (decode "test.txt") + , test_WithTextFile "utf8" + (fromText "\xA1\xA2.txt") + , test_WithTextFile "iso8859" + (decode "\xA1\xA2\xA3.txt") + ] + +suite_RegressionTests :: Suite +suite_RegressionTests = suite "regression-tests" + [ test_ListDirectoryLeaksFds + ] + +test_IsFile :: String -> FilePath -> Test test_IsFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do let path = tmp file_name @@ -257,7 +301,7 @@ after <- liftIO $ Filesystem.isFile path $expect after -test_PipeIsFile :: Text -> FilePath -> Suite +test_PipeIsFile :: String -> FilePath -> Test test_PipeIsFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do let path = tmp file_name @@ -269,7 +313,7 @@ after <- liftIO $ Filesystem.isFile path $expect after -test_IsDirectory :: Text -> FilePath -> Suite +test_IsDirectory :: String -> FilePath -> Test test_IsDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do let path = tmp dir_name @@ -281,7 +325,7 @@ after <- liftIO $ Filesystem.isDirectory path $expect after -test_Rename :: Text -> FilePath -> FilePath -> Suite +test_Rename :: String -> FilePath -> FilePath -> Test test_Rename test_name old_name new_name = assertionsWithTemp test_name $ \tmp -> do let old_path = tmp old_name let new_path = tmp new_name @@ -300,7 +344,7 @@ $expect (not old_after) $expect new_after -test_CopyFile :: Text -> FilePath -> FilePath -> Suite +test_CopyFile :: String -> FilePath -> FilePath -> Test test_CopyFile test_name old_name new_name = assertionsWithTemp test_name $ \tmp -> do let old_path = tmp old_name let new_path = tmp new_name @@ -326,7 +370,7 @@ Data.Text.IO.hGetContents $expect (equalLines old_contents new_contents) -test_CanonicalizePath :: Text -> FilePath -> FilePath -> Suite +test_CanonicalizePath :: String -> FilePath -> FilePath -> Test test_CanonicalizePath test_name src_name dst_name = assertionsWithTemp test_name $ \tmp -> do let src_path = tmp src_name let subdir = tmp "subdir" @@ -344,7 +388,7 @@ canonicalized <- liftIO $ Filesystem.canonicalizePath src_path $expect $ equal canonicalized dst_path -test_CanonicalizePath_TrailingSlash :: Suite +test_CanonicalizePath_TrailingSlash :: Test test_CanonicalizePath_TrailingSlash = assertionsWithTemp "trailing-slash" $ \tmp -> do let src_path = tmp "src" let subdir = tmp "subdir" @@ -362,7 +406,7 @@ canonicalized <- liftIO (Filesystem.canonicalizePath (src_path empty)) $expect (equal canonicalized (dst_path empty)) -test_CreateDirectory :: Text -> FilePath -> Suite +test_CreateDirectory :: String -> FilePath -> Test test_CreateDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do let dir_path = tmp dir_name @@ -374,7 +418,7 @@ $expect exists_after -test_CreateDirectory_FailExists :: Suite +test_CreateDirectory_FailExists :: Test test_CreateDirectory_FailExists = assertionsWithTemp "fail-if-exists" $ \tmp -> do let dir_path = tmp "subdir" mkdir_ffi dir_path @@ -383,14 +427,14 @@ (mkAlreadyExists "createDirectory" dir_path) (Filesystem.createDirectory False dir_path) -test_CreateDirectory_SucceedExists :: Suite +test_CreateDirectory_SucceedExists :: Test test_CreateDirectory_SucceedExists = assertionsWithTemp "succeed-if-exists" $ \tmp -> do let dir_path = tmp "subdir" mkdir_ffi dir_path liftIO $ Filesystem.createDirectory True dir_path -test_CreateDirectory_FailFileExists :: Suite +test_CreateDirectory_FailFileExists :: Test test_CreateDirectory_FailFileExists = assertionsWithTemp "fail-if-file-exists" $ \tmp -> do let dir_path = tmp "subdir" touch_ffi dir_path "" @@ -409,7 +453,7 @@ #endif (Just (CurrentOS.encodeString path)) -test_CreateTree :: Text -> FilePath -> Suite +test_CreateTree :: String -> FilePath -> Test test_CreateTree test_name dir_name = assertionsWithTemp test_name $ \tmp -> do let dir_path = tmp dir_name let subdir = dir_path "subdir" @@ -426,7 +470,7 @@ $expect dir_exists_after $expect subdir_exists_after -test_ListDirectory :: Suite +test_ListDirectory :: Test test_ListDirectory = assertionsWithTemp "listDirectory" $ \tmp -> do -- OSX replaces non-UTF8 filenames with http-style %XX escapes let paths = @@ -446,7 +490,7 @@ names <- liftIO $ Filesystem.listDirectory tmp $expect $ sameItems paths names -test_RemoveFile :: Text -> FilePath -> Suite +test_RemoveFile :: String -> FilePath -> Test test_RemoveFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do let file_path = tmp file_name @@ -460,7 +504,7 @@ after <- liftIO $ Filesystem.isFile file_path $expect (not after) -test_RemoveDirectory :: Text -> FilePath -> Suite +test_RemoveDirectory :: String -> FilePath -> Test test_RemoveDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do let dir_path = tmp dir_name @@ -474,7 +518,7 @@ after <- liftIO $ Filesystem.isDirectory dir_path $expect (not after) -test_RemoveTree :: Text -> FilePath -> Suite +test_RemoveTree :: String -> FilePath -> Test test_RemoveTree test_name dir_name = assertionsWithTemp test_name $ \tmp -> do let dir_path = tmp dir_name let subdir = dir_path "subdir" @@ -494,7 +538,7 @@ $expect (not dir_after) $expect (not subdir_after) -test_GetWorkingDirectory :: Text -> FilePath -> Suite +test_GetWorkingDirectory :: String -> FilePath -> Test test_GetWorkingDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do -- canonicalize to avoid issues with symlinked temp dirs canon_tmp <- liftIO (Filesystem.canonicalizePath tmp) @@ -506,7 +550,7 @@ cwd <- liftIO $ Filesystem.getWorkingDirectory $expect (equal cwd dir_path) -test_SetWorkingDirectory :: Text -> FilePath -> Suite +test_SetWorkingDirectory :: String -> FilePath -> Test test_SetWorkingDirectory test_name dir_name = assertionsWithTemp test_name $ \tmp -> do -- canonicalize to avoid issues with symlinked temp dirs canon_tmp <- liftIO (Filesystem.canonicalizePath tmp) @@ -518,12 +562,12 @@ cwd <- getcwd_ffi $expect (equal cwd dir_path) -test_GetHomeDirectory :: Text -> FilePath -> Suite +test_GetHomeDirectory :: String -> FilePath -> Test test_GetHomeDirectory test_name dir_name = assertions test_name $ do path <- liftIO $ withEnv "HOME" (Just dir_name) Filesystem.getHomeDirectory $expect (equal path dir_name) -test_GetDesktopDirectory :: Text -> FilePath -> Suite +test_GetDesktopDirectory :: String -> FilePath -> Test test_GetDesktopDirectory test_name dir_name = assertions test_name $ do path <- liftIO $ withEnv "XDG_DESKTOP_DIR" (Just dir_name) $ @@ -536,7 +580,7 @@ Filesystem.getDesktopDirectory $expect (equal fallback (dir_name "Desktop")) -test_GetModified :: Text -> FilePath -> Suite +test_GetModified :: String -> FilePath -> Test test_GetModified test_name file_name = assertionsWithTemp test_name $ \tmp -> do let file_path = tmp file_name @@ -546,7 +590,7 @@ mtime <- liftIO $ Filesystem.getModified file_path $expect (equalWithin (diffUTCTime mtime now) 0 2) -test_GetSize :: Text -> FilePath -> Suite +test_GetSize :: String -> FilePath -> Test test_GetSize test_name file_name = assertionsWithTemp test_name $ \tmp -> do let file_path = tmp file_name let contents = "contents\n" @@ -556,7 +600,7 @@ size <- liftIO $ Filesystem.getSize file_path $expect (equal size (toInteger (Data.ByteString.length contents))) -test_WithFile_Read :: Text -> FilePath -> Suite +test_WithFile_Read :: String -> FilePath -> Test test_WithFile_Read test_name file_name = assertionsWithTemp test_name $ \tmp -> do let file_path = tmp file_name let contents = "contents\n" @@ -568,7 +612,7 @@ Data.ByteString.hGetContents $expect (equalLines contents read_contents) -test_WithFile_Write :: Text -> FilePath -> Suite +test_WithFile_Write :: String -> FilePath -> Test test_WithFile_Write test_name file_name = assertionsWithTemp test_name $ \tmp -> do let file_path = tmp file_name let contents = "contents\n" @@ -582,7 +626,7 @@ Data.ByteString.hGetContents $expect (equalLines contents read_contents) -test_WithTextFile :: Text -> FilePath -> Suite +test_WithTextFile :: String -> FilePath -> Test test_WithTextFile test_name file_name = assertionsWithTemp test_name $ \tmp -> do let file_path = tmp file_name let contents = "contents\n" @@ -594,7 +638,7 @@ Data.Text.IO.hGetContents $expect (equalLines (Data.Text.pack contents) read_contents) -test_ListDirectoryLeaksFds :: Suite +test_ListDirectoryLeaksFds :: Test test_ListDirectoryLeaksFds = assertionsWithTemp "listDirectory-leaks-fds" $ \tmp -> do -- Test that listDirectory doesn't leak file descriptors. let dir_path = tmp "subdir" diff --git a/tests/FilesystemTests/Util.hs b/tests/FilesystemTests/Util.hs --- a/tests/FilesystemTests/Util.hs +++ b/tests/FilesystemTests/Util.hs @@ -12,26 +12,23 @@ import Prelude hiding (FilePath) import Control.Exception (finally) -import Data.Text (Text, unpack) import System.IO.Temp (withSystemTempDirectory) import Test.Chell import Filesystem (removeTree) import Filesystem.Path.CurrentOS (FilePath, decodeString) -assertionsWithTemp :: Text -> (FilePath -> Assertions a) -> Suite -assertionsWithTemp name io = test (Test name impl) where +assertionsWithTemp :: String -> (FilePath -> Assertions a) -> Test +assertionsWithTemp name io = test name impl where impl options = withTempDir name $ \dir -> do - case suiteTests (assertions name (io dir)) of - [(Test _ io')] -> io' options - _ -> error "assertionsWithTemp: use in place of 'assertions' only." + runTest (assertions name (io dir)) options -withTempDir :: Text -> (FilePath -> IO a) -> IO a +withTempDir :: String -> (FilePath -> IO a) -> IO a withTempDir name io = withSystemTempDirectory - ("tests." ++ unpack name ++ ".") + ("tests." ++ name ++ ".") (\dir -> let dir' = decodeString dir in finally (io dir') (removeTree dir')) -todo :: Text -> Suite +todo :: String -> Test todo name = skipIf True (assertions name (return ())) diff --git a/tests/FilesystemTests/Windows.hs b/tests/FilesystemTests/Windows.hs --- a/tests/FilesystemTests/Windows.hs +++ b/tests/FilesystemTests/Windows.hs @@ -5,7 +5,7 @@ -- -- See license.txt for details module FilesystemTests.Windows - ( test_Windows + ( suite_Windows ) where import Control.Monad @@ -17,8 +17,8 @@ import FilesystemTests.Util (assertionsWithTemp, todo) -test_Windows :: Suite -test_Windows = suite "windows" +suite_Windows :: Suite +suite_Windows = suite "windows" [ todo "isFile" , todo "isDirectory" , todo "rename" @@ -52,7 +52,7 @@ , todo "appendTextFile" ] -test_ListDirectory :: Suite +test_ListDirectory :: Test test_ListDirectory = assertionsWithTemp "listDirectory" $ \dir -> do let paths = [ dir decode "test.txt"