diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
new file mode 100644
index 0000000000000000000000000000000000000000..d166a22755254c7a3baed7e1a2aee7d23bb68b0e
--- /dev/null
+++ b/.github/workflows/ci.yml
@@ -0,0 +1,124 @@
+name: ci
+on:
+  - push
+  - pull_request
+
+defaults:
+  run:
+    shell: bash
+
+jobs:
+  build:
+    runs-on: ${{ matrix.os }}
+    strategy:
+      fail-fast: true
+      matrix:
+        os: [ubuntu-latest, macOS-latest]
+        ghc: ['9.2', '9.0', '8.10', '8.8', '8.6', '8.4', '8.2']
+    steps:
+    - uses: actions/checkout@v2
+    - uses: haskell/actions/setup@v1
+      id: setup-haskell-cabal
+      with:
+        ghc-version: ${{ matrix.ghc }}
+    - uses: actions/cache@v2
+      name: Cache cabal stuff
+      with:
+        path: |
+          ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
+          dist-newstyle
+        key: ${{ runner.os }}-${{ matrix.ghc }}
+    - name: Build
+      run: |
+        cabal --version
+        cabal update
+        autoreconf --version
+        autoreconf -i
+        cabal sdist -z -o .
+        cabal get unix-*.tar.gz
+        cd unix-*/
+        cabal test all --test-show-details=direct
+    - name: Haddock
+      run: cabal haddock
+
+  centos7:
+    runs-on: ubuntu-latest
+    container:
+      image: centos:7
+    steps:
+    - name: Install
+      run: |
+        yum install -y gcc gmp gmp-devel make ncurses ncurses-compat-libs xz perl autoconf
+        curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
+    - uses: actions/checkout@v2
+    - name: Test
+      run: |
+        source ~/.ghcup/env
+        cabal --version
+        cabal update
+        autoreconf --version
+        autoreconf -i
+        cabal test all --test-show-details=direct
+
+  fedora34:
+    runs-on: ubuntu-latest
+    container:
+      image: fedora:34
+    steps:
+    - name: Install
+      run: |
+        dnf install -y gcc gmp gmp-devel make ncurses ncurses-compat-libs xz perl autoconf
+        curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
+    - uses: actions/checkout@v2
+    - name: Test
+      run: |
+        source ~/.ghcup/env
+        cabal --version
+        cabal update
+        autoreconf --version
+        autoreconf -i
+        cabal test all --test-show-details=direct
+
+  i386:
+    runs-on: ubuntu-latest
+    container:
+      image: i386/ubuntu:bionic
+    steps:
+    - name: Install
+      run: |
+        apt-get update -y
+        apt-get install -y autoconf build-essential zlib1g-dev libgmp-dev curl
+        curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 sh
+    - uses: actions/checkout@v1
+    - name: Test
+      run: |
+        source ~/.ghcup/env
+        cabal --version
+        cabal update
+        autoreconf --version
+        autoreconf -i
+        cabal v2-test --constraint 'optparse-applicative -process' --constraint 'QuickCheck +old-random' --constraint 'tasty -unix' all
+
+  arm:
+    runs-on: ubuntu-latest
+    strategy:
+      fail-fast: false
+      matrix:
+        arch: ['armv7', 'aarch64']
+    steps:
+    - uses: actions/checkout@v2
+    - uses: uraimo/run-on-arch-action@v2.1.1
+      timeout-minutes: 120
+      with:
+        arch: ${{ matrix.arch }}
+        distro: ubuntu20.04
+        githubToken: ${{ github.token }}
+        install: |
+          apt-get update -y
+          apt-get install -y ghc cabal-install autoconf
+        run: |
+          cabal --version
+          cabal update
+          autoreconf --version
+          autoreconf -i
+          cabal v2-test --constraint 'optparse-applicative -process' --constraint 'QuickCheck +old-random' --constraint 'tasty -unix' all
diff --git a/System/Posix/Env/ByteString.hsc b/System/Posix/Env/ByteString.hsc
index 3ce867b0073f1a00142802994df15fb01370dc82..65302d25a09465c537837a3a74d7221e90089b82 100644
--- a/System/Posix/Env/ByteString.hsc
+++ b/System/Posix/Env/ByteString.hsc
@@ -1,8 +1,5 @@
 {-# LANGUAGE CApiFFI #-}
 {-# LANGUAGE Trustworthy #-}
-#if __GLASGOW_HASKELL__ >= 709
-{-# OPTIONS_GHC -fno-warn-trustworthy-safe #-}
-#endif
 
 -----------------------------------------------------------------------------
 -- |
@@ -24,9 +21,11 @@ module System.Posix.Env.ByteString (
         , getEnvDefault
         , getEnvironmentPrim
         , getEnvironment
+        , setEnvironment
         , putEnv
         , setEnv
-       , unsetEnv
+        , unsetEnv
+        , clearEnv
 
        -- * Program arguments
        , getArgs
@@ -34,14 +33,16 @@ module System.Posix.Env.ByteString (
 
 #include "HsUnix.h"
 
+import Control.Monad
 import Foreign
 import Foreign.C
-import Control.Monad    ( liftM )
 import Data.Maybe       ( fromMaybe )
 
+import System.Posix.Env ( clearEnv )
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 import Data.ByteString (ByteString)
+import Data.ByteString.Internal (ByteString (PS), memcpy)
 
 -- |'getEnv' looks up a variable in the environment.
 
@@ -55,8 +56,8 @@ getEnv name = do
      else return Nothing
 
 -- |'getEnvDefault' is a wrapper around 'getEnv' where the
--- programmer can specify a fallback if the variable is not found
--- in the environment.
+-- programmer can specify a fallback as the second argument, which will be
+-- used if the variable is not found in the environment.
 
 getEnvDefault ::
   ByteString    {- ^ variable name                    -} ->
@@ -100,6 +101,18 @@ getEnvironment = do
       | BC.head y == '=' = (x,B.tail y)
       | otherwise       = error $ "getEnvironment: insane variable " ++ BC.unpack x
 
+-- |'setEnvironment' resets the entire environment to the given list of
+-- @(key,value)@ pairs.
+--
+-- @since 2.7.3
+setEnvironment ::
+  [(ByteString,ByteString)] {- ^ @[(key,value)]@ -} ->
+  IO ()
+setEnvironment env = do
+  clearEnv
+  forM_ env $ \(key,value) ->
+    setEnv key value True {-overwrite-}
+
 -- |The 'unsetEnv' function deletes all instances of the variable name
 -- from the environment.
 
@@ -120,15 +133,25 @@ foreign import capi unsafe "HsUnix.h unsetenv"
    c_unsetenv :: CString -> IO ()
 # endif
 #else
-unsetEnv name = putEnv (name ++ "=")
+unsetEnv name = putEnv (BC.snoc name '=')
 #endif
 
 -- |'putEnv' function takes an argument of the form @name=value@
 -- and is equivalent to @setEnv(key,value,True{-overwrite-})@.
 
 putEnv :: ByteString {- ^ "key=value" -} -> IO ()
-putEnv keyvalue = B.useAsCString keyvalue $ \s ->
-  throwErrnoIfMinus1_ "putenv" (c_putenv s)
+putEnv (PS fp o l) = withForeignPtr fp $ \p -> do
+  -- https://pubs.opengroup.org/onlinepubs/009696899/functions/putenv.html
+  --
+  -- "the string pointed to by string shall become part of the environment,
+  -- so altering the string shall change the environment. The space used by
+  -- string is no longer used once a new string which defines name is passed to putenv()."
+  --
+  -- hence we must not free the buffer
+  buf <- mallocBytes (l+1)
+  memcpy buf (p `plusPtr` o) l
+  pokeByteOff buf l (0::Word8)
+  throwErrnoIfMinus1_ "putenv" (c_putenv (castPtr buf))
 
 foreign import ccall unsafe "putenv"
    c_putenv :: CString -> IO CInt
diff --git a/System/Posix/Fcntl.hsc b/System/Posix/Fcntl.hsc
index c78f36128611a5e7aa46b761e4a0915702448dd4..a32c987b6c8a2c7e1078cb2c6361e65a59710485 100644
--- a/System/Posix/Fcntl.hsc
+++ b/System/Posix/Fcntl.hsc
@@ -92,7 +92,10 @@ fileAdvise _ _ _ _ = return ()
 fileAllocate :: Fd -> FileOffset -> FileOffset -> IO ()
 #if HAVE_POSIX_FALLOCATE
 fileAllocate fd off len = do
-  throwErrnoIfMinus1_ "fileAllocate" (c_posix_fallocate (fromIntegral fd) (fromIntegral off) (fromIntegral len))
+  ret <- c_posix_fallocate (fromIntegral fd) (fromIntegral off) (fromIntegral len)
+  if ret == 0
+    then pure ()
+    else ioError (errnoToIOError "fileAllocate" (Errno ret) Nothing Nothing)
 
 foreign import capi safe "fcntl.h posix_fallocate"
   c_posix_fallocate :: CInt -> COff -> COff -> IO CInt
diff --git a/System/Posix/Resource.hsc b/System/Posix/Resource.hsc
index 309d3945441367298a7168b68cd6712c7ef1f837..0511a0cc44062efe6a494731e5c26eb57cbd36f6 100644
--- a/System/Posix/Resource.hsc
+++ b/System/Posix/Resource.hsc
@@ -111,12 +111,18 @@ unpackRLimit other
 
 packRLimit :: ResourceLimit -> Bool -> CRLim
 packRLimit ResourceLimitInfinity _     = (#const RLIM_INFINITY)
-#ifdef RLIM_SAVED_CUR
+#if defined(RLIM_SAVED_CUR)
 packRLimit ResourceLimitUnknown  True  = (#const RLIM_SAVED_CUR)
 #endif
-#ifdef RLIM_SAVED_MAX
+#if defined(RLIM_SAVED_MAX)
 packRLimit ResourceLimitUnknown  False = (#const RLIM_SAVED_MAX)
 #endif
+#if ! defined(RLIM_SAVED_MAX) && !defined(RLIM_SAVED_CUR)
+packRLimit ResourceLimitUnknown  _     =
+    error
+      $ "System.Posix.Resource.packRLimit: " ++
+        "ResourceLimitUnknown but RLIM_SAVED_MAX/RLIM_SAVED_CUR not defined by platform"
+#endif
 packRLimit (ResourceLimit other) _     = fromIntegral other
 
 
diff --git a/System/Posix/Semaphore.hsc b/System/Posix/Semaphore.hsc
index 12db9240ad4fdd25b74ace2dc85d71789c45ee33..675635e370305c3bc3d056a52b2fc3743cdb09d6 100644
--- a/System/Posix/Semaphore.hsc
+++ b/System/Posix/Semaphore.hsc
@@ -3,6 +3,7 @@
 #else
 {-# LANGUAGE Trustworthy #-}
 #endif
+{-# LANGUAGE CApiFFI #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.Posix.Semaphore
@@ -114,18 +115,18 @@ semGetValue_ sem ptr = do throwErrnoIfMinus1Retry_ "semGetValue" $
                           cint <- peek ptr
                           return $ fromEnum cint
 
-foreign import ccall safe "sem_open"
+foreign import capi safe "semaphore.h sem_open"
         sem_open :: CString -> CInt -> CMode -> CUInt -> IO (Ptr ())
-foreign import ccall safe "sem_close"
+foreign import capi safe "semaphore.h sem_close"
         sem_close :: Ptr () -> IO CInt
-foreign import ccall safe "sem_unlink"
+foreign import capi safe "semaphore.h sem_unlink"
         sem_unlink :: CString -> IO CInt
 
-foreign import ccall safe "sem_wait"
+foreign import capi safe "semaphore.h sem_wait"
         sem_wait :: Ptr () -> IO CInt
-foreign import ccall safe "sem_trywait"
+foreign import capi safe "semaphore.h sem_trywait"
         sem_trywait :: Ptr () -> IO CInt
-foreign import ccall safe "sem_post"
+foreign import capi safe "semaphore.h sem_post"
         sem_post :: Ptr () -> IO CInt
-foreign import ccall safe "sem_getvalue"
+foreign import capi safe "semaphore.h sem_getvalue"
         sem_getvalue :: Ptr () -> Ptr CInt -> IO Int
diff --git a/System/Posix/Terminal/Common.hsc b/System/Posix/Terminal/Common.hsc
index 27731587c82d0d71d5111d876b4bb71670dd77fd..5c629fdc4026d94738ee2006a0b494ed549c3b0e 100644
--- a/System/Posix/Terminal/Common.hsc
+++ b/System/Posix/Terminal/Common.hsc
@@ -335,6 +335,7 @@ data BaudRate
   | B38400
   | B57600
   | B115200
+  deriving (Eq, Show)
 
 inputSpeed :: TerminalAttributes -> BaudRate
 inputSpeed termios = unsafePerformIO $ do
diff --git a/cabal.project b/cabal.project
new file mode 100644
index 0000000000000000000000000000000000000000..50c6c320c9fe0a151f3d7ac33be1bd9ef7c02b09
--- /dev/null
+++ b/cabal.project
@@ -0,0 +1,6 @@
+packages: .
+
+tests: True
+
+constraints:
+  tasty -unix, optparse-applicative -process
diff --git a/cbits/HsUnix.c b/cbits/HsUnix.c
index 7c72a341cbbdabeea820b4acd375ffbd1da30e17..fb49a1e0a492a69b455f94cc228d4d4262a36456 100644
--- a/cbits/HsUnix.c
+++ b/cbits/HsUnix.c
@@ -47,7 +47,7 @@ int __hsunix_push_module(int fd, const char *module)
  * re-entrant.
  */
 
-#if defined (__GLIBC__) && (__GLIBC__ >= 2) && (__GLIBC_MINOR__ >= 23)
+#if defined (__GLIBC__) && ((__GLIBC__ > 2) || (__GLIBC__ == 2) && (__GLIBC_MINOR__ >= 23))
 #define USE_READDIR_R 0
 #else
 #define USE_READDIR_R 1
diff --git a/changelog.md b/changelog.md
index cb8003f87a4f347e84d299ca4068f27bb13d39c7..f2c087099a8ba490fb1154f553fc32e3d5507f87 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,5 +1,23 @@
 # Changelog for [`unix` package](http://hackage.haskell.org/package/unix)
 
+## 2.7.2.3  *Unreleased*
+
+  * Resource: Fix warning in case of no RLIM_SAVED_{CUR,MAX}
+
+  * Future-proof glibc version check
+
+  * Fix the error handling of posix_fallocate in non-FreeBSD
+
+  * Synchronize ByteString and String modules and fix grave bug in 'putEnv'
+
+  * Fix 'semTrywait: invalid argument (Bad file descriptor)' wrt #218
+
+  * Improve error messages
+
+  * Improve tests
+
+  * Don't show repo as modified after configure
+
 ## 2.7.2.2  *May 2017*
 
   * Bundled with GHC 8.2.1
diff --git a/tests/fdReadBuf001.hs b/tests/FdReadBuf001.hs
similarity index 62%
rename from tests/fdReadBuf001.hs
rename to tests/FdReadBuf001.hs
index f987c94091e9b2a5e4a4c8561c5ff1ba18bfc837..54a9f832d8aeadc74cdad62f9bf2a4a82f262d05 100644
--- a/tests/fdReadBuf001.hs
+++ b/tests/FdReadBuf001.hs
@@ -1,24 +1,25 @@
-{-# LANGUAGE NoMonomorphismRestriction #-}
+module Main where
+
 import System.Posix
 import Control.Monad
-import Foreign
+import Foreign hiding (void)
 import Control.Concurrent
 import Data.Char
 import System.Exit
 
-size  = 10000
-block = 512
-
+main :: IO ()
 main = do
+  let size  = 10000
+      block = 512
   (rd,wr) <- createPipe
   let bytes = take size (map (fromIntegral.ord) (cycle ['a'..'z']))
-  allocaBytes size $ \p -> do
-    pokeArray p bytes
-    forkIO $ do r <- fdWriteBuf wr p (fromIntegral size)
-                when (fromIntegral r /= size) $ error "fdWriteBuf failed"
+  void $ forkIO $ allocaBytes size $ \p -> do
+        pokeArray p bytes
+        r <- fdWriteBuf wr p (fromIntegral size)
+        when (fromIntegral r /= size) $ error "fdWriteBuf failed"
   allocaBytes block $ \p -> do
     let loop text = do
-           r <- fdReadBuf rd p block
+           r <- fdReadBuf rd p (fromIntegral block)
            let (chunk,rest) = splitAt (fromIntegral r) text
            chars <- peekArray (fromIntegral r) p
            when (chars /= chunk) $ error $ "mismatch: expected="++show chunk++", found="++show chars
diff --git a/tests/fileStatus.hs b/tests/FileStatus.hs
similarity index 69%
rename from tests/fileStatus.hs
rename to tests/FileStatus.hs
index 262d396be5aab8e6ca21ef424145ee2827e7e17e..6ea0642ef04c4b3302e4cb5ddb80edafcd7fe548 100644
--- a/tests/fileStatus.hs
+++ b/tests/FileStatus.hs
@@ -1,26 +1,33 @@
 
 -- GHC trac #2969
 
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+module FileStatus (main) where
+
 import System.Posix.Files
 import System.Posix.Directory
 import System.Posix.IO
 import Control.Exception as E
 import Control.Monad
+import Test.Tasty.HUnit
 
 main = do
   cleanup
   fs <- testRegular
   ds <- testDir
   testSymlink fs ds
+  testLink
   cleanup
 
-regular      = "regular"
-dir          = "dir"
-link_regular = "link-regular"
-link_dir     = "link-dir"
+regular       = "regular"
+dir           = "dir"
+slink_regular = "link-regular-symlink"
+hlink_regular = "link-regular-hardlink"
+link_dir      = "link-dir"
 
 testRegular = do
-  createFile regular ownerReadMode
+  _ <- createFile regular ownerReadMode
   (fs, _) <- getStatus regular
   let expected = (False,False,False,True,False,False,False)
       actual   = snd (statusElements fs)
@@ -38,9 +45,9 @@ testDir = do
   return ds
 
 testSymlink fs ds = do
-  createSymbolicLink regular link_regular
+  createSymbolicLink regular slink_regular
   createSymbolicLink dir     link_dir
-  (fs', ls)  <- getStatus link_regular
+  (fs', ls)  <- getStatus slink_regular
   (ds', lds) <- getStatus link_dir
 
   let expected = (False,False,False,False,False,True,False)
@@ -59,10 +66,27 @@ testSymlink fs ds = do
   when (statusElements ds /= statusElements ds') $
     fail "status for a directory does not match when it's accessed via a symlink"
 
+
+testLink = do
+  createLink regular hlink_regular
+  (fs, _)  <- getStatus regular -- we need to retrieve it again as creating the link causes it to change!
+  (fs', ls)  <- getStatus hlink_regular
+  snd (statusElements ls) @?= (
+                False, -- isBlockDevice
+                False, -- isCharacterDevice
+                False, -- isNamedPipe
+                True,  -- isRegularFile
+                False, -- isDirectory
+                False, -- isSymbolicLink
+                False) -- isSocket
+  linkCount fs' == 2 @? "Newly created hard link was expected to have a link count of 2"
+  statusElements fs @?= statusElements fs' -- status for a file should match when accessed via a link
+
+
 cleanup = do
   ignoreIOExceptions $ removeDirectory dir
   mapM_ (ignoreIOExceptions . removeLink)
-        [regular, link_regular, link_dir]
+        [regular, hlink_regular, slink_regular, link_dir]
 
 ignoreIOExceptions io = io `E.catch`
                         ((\_ -> return ()) :: IOException -> IO ())
diff --git a/tests/fileStatusByteString.hs b/tests/FileStatusByteString.hs
similarity index 69%
rename from tests/fileStatusByteString.hs
rename to tests/FileStatusByteString.hs
index ec492b32eadeea2a852b0dfcbcf4d2337553dd45..21904a793f48d0ef8f8f573bb8493b60ca709ffb 100644
--- a/tests/fileStatusByteString.hs
+++ b/tests/FileStatusByteString.hs
@@ -1,25 +1,32 @@
 {-# LANGUAGE OverloadedStrings #-}
 
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+module FileStatusByteString (main) where
+
 -- GHC trac #2969
 
 import System.Posix.ByteString
 import Control.Exception as E
 import Control.Monad
+import Test.Tasty.HUnit
 
 main = do
   cleanup
   fs <- testRegular
   ds <- testDir
   testSymlink fs ds
+  testLink
   cleanup
 
-regular      = "regular2"
-dir          = "dir2"
-link_regular = "link-regular2"
-link_dir     = "link-dir2"
+regular       = "regular2"
+dir           = "dir2"
+hlink_regular = "hlink-regular2"
+slink_regular = "slink-regular2"
+link_dir      = "link-dir2"
 
 testRegular = do
-  createFile regular ownerReadMode
+  _ <- createFile regular ownerReadMode
   (fs, _) <- getStatus regular
   let expected = (False,False,False,True,False,False,False)
       actual   = snd (statusElements fs)
@@ -37,9 +44,9 @@ testDir = do
   return ds
 
 testSymlink fs ds = do
-  createSymbolicLink regular link_regular
+  createSymbolicLink regular slink_regular
   createSymbolicLink dir     link_dir
-  (fs', ls)  <- getStatus link_regular
+  (fs', ls)  <- getStatus slink_regular
   (ds', lds) <- getStatus link_dir
 
   let expected = (False,False,False,False,False,True,False)
@@ -58,10 +65,26 @@ testSymlink fs ds = do
   when (statusElements ds /= statusElements ds') $
     fail "status for a directory does not match when it's accessed via a symlink"
 
+testLink = do
+  createLink regular hlink_regular
+  (fs, _)  <- getStatus regular -- we need to retrieve it again as creating the link causes it to change!
+  (fs', ls)  <- getStatus hlink_regular
+  snd (statusElements ls) @?= (
+                False, -- isBlockDevice
+                False, -- isCharacterDevice
+                False, -- isNamedPipe
+                True,  -- isRegularFile
+                False, -- isDirectory
+                False, -- isSymbolicLink
+                False) -- isSocket
+  linkCount fs' == 2 @? "Newly created hard link was expected to have a link count of 2"
+  statusElements fs @?= statusElements fs' -- status for a file should match when accessed via a link
+
+
 cleanup = do
   ignoreIOExceptions $ removeDirectory dir
   mapM_ (ignoreIOExceptions . removeLink)
-        [regular, link_regular, link_dir]
+        [regular, hlink_regular, slink_regular, link_dir]
 
 ignoreIOExceptions io = io `E.catch`
                         ((\_ -> return ()) :: IOException -> IO ())
diff --git a/tests/ForkProcess01.hs b/tests/ForkProcess01.hs
new file mode 100644
index 0000000000000000000000000000000000000000..8ddaec26c4ee6ca05bcec9bbd4eae7cdad34edcb
--- /dev/null
+++ b/tests/ForkProcess01.hs
@@ -0,0 +1,17 @@
+-- Test that we can call exitFailure in a forked process, and have it
+-- communicated properly to the parent.
+
+module Main where
+
+import Control.Monad
+import System.Exit
+import System.Posix.Process
+
+main :: IO ()
+main = do
+  let exitCode = ExitFailure 72
+      expected = Just (Exited exitCode)
+  p <- forkProcess $ exitWith exitCode
+  actual <- getProcessStatus True False p
+  when (actual /= expected) $
+    error $ "mismatch: expected = " ++ show expected ++ ", actual = " ++ show actual
diff --git a/tests/Makefile b/tests/Makefile
deleted file mode 100644
index 6a0abcf1cf7f79f47ac3db01eec1eb9ff6ff7b45..0000000000000000000000000000000000000000
--- a/tests/Makefile
+++ /dev/null
@@ -1,7 +0,0 @@
-# This Makefile runs the tests using GHC's testsuite framework.  It
-# assumes the package is part of a GHC build tree with the testsuite
-# installed in ../../../testsuite.
-
-TOP=../../../testsuite
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/tests/libposix/posix004.hs b/tests/Posix004.hs
similarity index 54%
rename from tests/libposix/posix004.hs
rename to tests/Posix004.hs
index 56c16f02dc1262da10b7519783554fda2aaff2f6..da949ffe19ee0f6ded629420e73f707bd502fb33 100644
--- a/tests/libposix/posix004.hs
+++ b/tests/Posix004.hs
@@ -1,48 +1,54 @@
+module Main where
 
-import System.Exit (ExitCode(..), exitWith)
+import System.Exit
 import System.Posix.Process
 import System.Posix.Signals
 
-main = do test1
-          test2
-          test3
-          test4
-          putStrLn "I'm happy."
+main :: IO ()
+main = do
+    test1
+    test2
+    test3
+    test4
 
+test1 :: IO ()
 test1 = do
     -- Force SIGFPE exceptions to not be ignored.  Under some
     -- circumstances this test will be run with SIGFPE
     -- ignored, see #7399
-    installHandler sigFPE Default Nothing
-    forkProcess $ raiseSignal floatingPointException
-    Just (pid, tc) <- getAnyProcessStatus True False
+    _ <- installHandler sigFPE Default Nothing
+    _ <- forkProcess $ raiseSignal floatingPointException
+    Just (_, tc) <- getAnyProcessStatus True False
     case tc of
         Terminated sig _ | sig == floatingPointException -> return ()
         _ -> error "unexpected termination cause"
 
+test2 :: IO ()
 test2 = do
-    forkProcess $ exitImmediately (ExitFailure 42)
-    Just (pid, tc) <- getAnyProcessStatus True False
+    _ <- forkProcess $ exitImmediately (ExitFailure 42)
+    Just (_, tc) <- getAnyProcessStatus True False
     case tc of
         Exited (ExitFailure 42) -> return ()
         _ -> error "unexpected termination cause (2)"
 
+test3 :: IO ()
 test3 = do
-    forkProcess $ exitImmediately ExitSuccess
-    Just (pid, tc) <- getAnyProcessStatus True False
+    _ <- forkProcess $ exitImmediately ExitSuccess
+    Just (_, tc) <- getAnyProcessStatus True False
     case tc of
         Exited ExitSuccess -> return ()
         _ -> error "unexpected termination cause (3)"
 
+test4 :: IO ()
 test4 = do
-    forkProcess $ raiseSignal softwareStop
+    _ <- forkProcess $ raiseSignal softwareStop
     Just (pid, tc) <- getAnyProcessStatus True True
     case tc of
         Stopped sig | sig == softwareStop -> do
             signalProcess killProcess pid
-            Just (pid, tc) <- getAnyProcessStatus True True
-            case tc of
-                Terminated sig _ | sig == killProcess -> return ()
+            Just (_, tc') <- getAnyProcessStatus True True
+            case tc' of
+                Terminated sig' _ | sig' == killProcess -> return ()
                 _ -> error "unexpected termination cause (5)"
         _ -> error "unexpected termination cause (4)"
 
diff --git a/tests/Posix009.hs b/tests/Posix009.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9fbfe142e8b148cea4e86211f47f97debc817638
--- /dev/null
+++ b/tests/Posix009.hs
@@ -0,0 +1,21 @@
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+
+module Main where
+
+import Control.Monad
+import System.Posix.Signals
+import System.Posix.Unistd
+
+main :: IO ()
+main = do
+  putStrLn "Blocking real time alarms."
+  blockSignals (addSignal realTimeAlarm reservedSignals)
+  putStrLn "Scheduling an alarm in 2 seconds..."
+  _ <- scheduleAlarm 2
+  putStrLn "Sleeping 5 seconds."
+  _ <- sleep 5
+  putStrLn "Woken up"
+  ints <- getPendingSignals
+  putStrLn "Checking pending interrupts for RealTimeAlarm"
+  unless (inSignalSet realTimeAlarm ints) $
+    error "should have a pending real time alarm"
diff --git a/tests/Posix014.hs b/tests/Posix014.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9634ea26b5a8be87e9f2e1c1d5e8fc8c9f3d1dd1
--- /dev/null
+++ b/tests/Posix014.hs
@@ -0,0 +1,15 @@
+{-# OPTIONS_GHC -Wno-deprecations #-}
+-- !! Basic pipe usage
+module Main (main) where
+
+import Control.Monad
+import System.Posix
+
+main :: IO ()
+main = do
+  let str = "Hi, there - forked child calling"
+  (rd, wd) <- createPipe
+  _ <- forkProcess $ void $ fdWrite wd str
+  (str', _) <- fdRead rd (fromIntegral (length str))
+  unless (str == str') $
+    error "should have received an identical string"
diff --git a/tests/PutEnv001.hs b/tests/PutEnv001.hs
new file mode 100644
index 0000000000000000000000000000000000000000..0a7f1af688d13d0b1c6e1eb30dff9c8e6483992b
--- /dev/null
+++ b/tests/PutEnv001.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -O0 -Wno-name-shadowing #-}
+
+module Main (main) where
+
+import Data.String ( fromString )
+import System.Mem
+import System.Posix.Env.ByteString
+import Test.Tasty
+import Test.Tasty.HUnit
+
+-- test regression of incorrect 'free': https://github.com/haskell/unix/issues/68#issue-170072591
+main :: IO ()
+main = do
+  putEnv "foo=bar"
+  defaultMain $ testGroup "All" [ test ]
+
+test :: TestTree
+test = testCase "putEnv" $ do
+  performMinorGC
+  env <- System.Posix.Env.ByteString.getEnv (fromString "foo")
+  performMinorGC
+  print env
+  env <- System.Posix.Env.ByteString.getEnv (fromString "foo")
+  performMinorGC
+  print env
+  env <- System.Posix.Env.ByteString.getEnv (fromString "foo")
+  performMinorGC
+  print env
+  env <- System.Posix.Env.ByteString.getEnv (fromString "foo")
+  print env
+  env @?= Just (fromString "bar")
diff --git a/tests/ResourceLimit.hs b/tests/ResourceLimit.hs
new file mode 100644
index 0000000000000000000000000000000000000000..edfd2b4715c0ba4bea1f83c4233952a12137b78f
--- /dev/null
+++ b/tests/ResourceLimit.hs
@@ -0,0 +1,18 @@
+module Main where
+
+import System.Posix
+import Test.Tasty.HUnit
+
+main :: IO ()
+main = do
+  let soft = 5
+      hard = 10
+  setResourceLimit ResourceCPUTime
+    (ResourceLimits (ResourceLimit soft) (ResourceLimit hard))
+  r <- getResourceLimit ResourceCPUTime
+  soft @?= case softLimit r of
+      ResourceLimit l -> l
+      _               -> 0
+  hard @?= case hardLimit r of
+      ResourceLimit l -> l
+      _               -> 0
diff --git a/tests/Semaphore001.hs b/tests/Semaphore001.hs
new file mode 100644
index 0000000000000000000000000000000000000000..e89fa15149787ebf0c015cdbbd1e81e770c22aca
--- /dev/null
+++ b/tests/Semaphore001.hs
@@ -0,0 +1,9 @@
+module Main (main) where
+
+import System.Posix
+
+main :: IO ()
+main = do
+  sem <- semOpen "/test" OpenSemFlags {semCreate = True, semExclusive = False} stdFileMode 1
+  semThreadWait sem
+  semPost sem
diff --git a/tests/Signals001.hs b/tests/Signals001.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9661ce736149549b9398e7a75fbf46fe319007dc
--- /dev/null
+++ b/tests/Signals001.hs
@@ -0,0 +1,118 @@
+{-# LANGUAGE CPP #-}
+
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+module Signals001 (main) where
+
+import Control.Monad
+import System.Posix.Signals
+
+#include "ghcconfig.h"
+
+main :: IO ()
+main = do
+  forM_ (filter id $ testMembers emptySignalSet) $ \_ ->
+    fail "should be False"
+  forM_ (filter id $ testMembers emptyset) $ \_ ->
+    fail "should be False"
+  forM_ (filter not $ testMembers fullSignalSet) $ \_ ->
+    fail "should be True"
+  forM_ (filter not $ testMembers fullset) $ \_ ->
+    fail "should be True"
+
+fullset = internalAbort `addSignal`
+    realTimeAlarm `addSignal`
+    busError `addSignal`
+    processStatusChanged `addSignal`
+    continueProcess `addSignal`
+    floatingPointException `addSignal`
+    lostConnection `addSignal`
+    illegalInstruction `addSignal`
+    keyboardSignal `addSignal`
+    killProcess `addSignal`
+    openEndedPipe `addSignal`
+    keyboardTermination `addSignal`
+    segmentationViolation `addSignal`
+    softwareStop `addSignal`
+    softwareTermination `addSignal`
+    keyboardStop `addSignal`
+    backgroundRead `addSignal`
+    backgroundWrite `addSignal`
+    userDefinedSignal1 `addSignal`
+    userDefinedSignal2 `addSignal`
+#if HAVE_SIGPOLL
+    pollableEvent `addSignal`
+#endif
+    profilingTimerExpired `addSignal`
+    badSystemCall `addSignal`
+    breakpointTrap `addSignal`
+    urgentDataAvailable `addSignal`
+    virtualTimerExpired `addSignal`
+    cpuTimeLimitExceeded `addSignal`
+    fileSizeLimitExceeded `addSignal`
+    emptySignalSet
+
+emptyset = internalAbort `deleteSignal`
+    realTimeAlarm `deleteSignal`
+    busError `deleteSignal`
+    processStatusChanged `deleteSignal`
+    continueProcess `deleteSignal`
+    floatingPointException `deleteSignal`
+    lostConnection `deleteSignal`
+    illegalInstruction `deleteSignal`
+    keyboardSignal `deleteSignal`
+    killProcess `deleteSignal`
+    openEndedPipe `deleteSignal`
+    keyboardTermination `deleteSignal`
+    segmentationViolation `deleteSignal`
+    softwareStop `deleteSignal`
+    softwareTermination `deleteSignal`
+    keyboardStop `deleteSignal`
+    backgroundRead `deleteSignal`
+    backgroundWrite `deleteSignal`
+    userDefinedSignal1 `deleteSignal`
+    userDefinedSignal2 `deleteSignal`
+#if HAVE_SIGPOLL
+    pollableEvent `deleteSignal`
+#endif
+    profilingTimerExpired `deleteSignal`
+    badSystemCall `deleteSignal`
+    breakpointTrap `deleteSignal`
+    urgentDataAvailable `deleteSignal`
+    virtualTimerExpired `deleteSignal`
+    cpuTimeLimitExceeded `deleteSignal`
+    fileSizeLimitExceeded `deleteSignal`
+    fullSignalSet
+
+testMembers set = [
+    internalAbort `inSignalSet` set,
+    realTimeAlarm `inSignalSet` set,
+    busError `inSignalSet` set,
+    processStatusChanged `inSignalSet` set,
+    continueProcess `inSignalSet` set,
+    floatingPointException `inSignalSet` set,
+    lostConnection `inSignalSet` set,
+    illegalInstruction `inSignalSet` set,
+    keyboardSignal `inSignalSet` set,
+    killProcess `inSignalSet` set,
+    openEndedPipe `inSignalSet` set,
+    keyboardTermination `inSignalSet` set,
+    segmentationViolation `inSignalSet` set,
+    softwareStop `inSignalSet` set,
+    softwareTermination `inSignalSet` set,
+    keyboardStop `inSignalSet` set,
+    backgroundRead `inSignalSet` set,
+    backgroundWrite `inSignalSet` set,
+    userDefinedSignal1 `inSignalSet` set,
+    userDefinedSignal2 `inSignalSet` set,
+#if HAVE_SIGPOLL
+    pollableEvent `inSignalSet` set,
+#endif
+    profilingTimerExpired `inSignalSet` set,
+    badSystemCall `inSignalSet` set,
+    breakpointTrap `inSignalSet` set,
+    urgentDataAvailable `inSignalSet` set,
+    virtualTimerExpired `inSignalSet` set,
+    cpuTimeLimitExceeded `inSignalSet` set,
+    fileSizeLimitExceeded `inSignalSet` set
+    ]
diff --git a/tests/signals002.hs b/tests/Signals002.hs
similarity index 53%
rename from tests/signals002.hs
rename to tests/Signals002.hs
index b2e6e5e422da6794a5ef136e8fbb8fa5b29820f6..3a2dbf20e010d33166355188236c5945a27bb0b4 100644
--- a/tests/signals002.hs
+++ b/tests/Signals002.hs
@@ -1,15 +1,20 @@
-import System.Posix
+module Main where
+
 import Control.Concurrent
+import Control.Monad
+import System.Posix
 
 -- !!! test blockSignals, raiseSignal, unblockSignals, getPendingSignals
 
+main :: IO ()
 main = do
   blockSignals ( userDefinedSignal1 `addSignal` emptySignalSet )
   raiseSignal userDefinedSignal1
   set <- getPendingSignals
-  print (userDefinedSignal1 `inSignalSet` set)
-  m <- newEmptyMVar 
-  installHandler userDefinedSignal1 
-	(Catch (putStrLn "hello" >> putMVar m ())) Nothing
+  unless (userDefinedSignal1 `inSignalSet` set) $
+    fail "signal is missing from the set"
+  m <- newEmptyMVar
+  _ <- installHandler userDefinedSignal1
+    (Catch (putStrLn "hello" >> putMVar m ())) Nothing
   awaitSignal (Just emptySignalSet)
   takeMVar m
diff --git a/tests/signals004.hs b/tests/Signals004.hs
similarity index 85%
rename from tests/signals004.hs
rename to tests/Signals004.hs
index d822056dbebf5d36418e4528e5ef873ca07cf0b9..6dcbb422ad7967d33e79d71f3cfca4cdeb9dab0e 100644
--- a/tests/signals004.hs
+++ b/tests/Signals004.hs
@@ -1,3 +1,7 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+module Main where
+
 import Control.Concurrent
 import System.Posix
 import Control.Monad
@@ -13,7 +17,7 @@ sigs = 400
 main = do
   c <- newChan
   m <- newEmptyMVar
-  installHandler sigUSR1 (handler c) Nothing
+  _ <- installHandler sigUSR1 (handler c) Nothing
   replicateM_ installers (forkIO $ do replicateM_ 1000 (install c); putMVar m ())
   replicateM_ sigs (forkIO $ raiseSignal sigUSR1)
   replicateM_ installers (takeMVar m)
diff --git a/tests/T1185.hs b/tests/T1185.hs
deleted file mode 100644
index 494841797481f019e21c326c1eea5390e1b11cd1..0000000000000000000000000000000000000000
--- a/tests/T1185.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-module Main where
-
-import Control.Concurrent
-import System.Posix
-import System.IO
-import System.Exit
-
-main =
-    do putStrLn "running..."
-       (stdinr, stdinw) <- createPipe
-       (stdoutr, stdoutw) <- createPipe
-       pid <- forkProcess $ do hw <- fdToHandle stdoutw
-                               hr <- fdToHandle stdinr
-                               closeFd stdinw
-                               hGetContents hr >>= hPutStr hw
-                               hClose hr
-                               hClose hw
-                               exitImmediately ExitSuccess
-       threadDelay 100000
-       closeFd stdoutw
-       closeFd stdinw
-       hr2 <- fdToHandle stdoutr
-       hGetContents hr2 >>= putStr
-       getProcessStatus True False pid >>= print
diff --git a/tests/T1185.stdout b/tests/T1185.stdout
deleted file mode 100644
index 706231432d7803f198e13e992cc04809c5afd055..0000000000000000000000000000000000000000
--- a/tests/T1185.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-running...
-Just (Exited ExitSuccess)
diff --git a/tests/T3816.hs b/tests/T3816.hs
deleted file mode 100644
index cda272fbe856024d5e222a2d1393087ccbcce038..0000000000000000000000000000000000000000
--- a/tests/T3816.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-import System.Posix
-main = do
-  getAllGroupEntries >>= print . (>0) . length
-  getAllGroupEntries >>= print . (>0) . length
diff --git a/tests/T3816.stdout b/tests/T3816.stdout
deleted file mode 100644
index dbde422651c9a2cfcc7cf081472dd40b13ed257c..0000000000000000000000000000000000000000
--- a/tests/T3816.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-True
-True
diff --git a/tests/T8108.hs b/tests/T8108.hs
index cf1c764486b436ced3bf001e930dd37a1d0a5ca7..e03d2e5c79e99befe5eb1f0479fb2caefebe3d17 100644
--- a/tests/T8108.hs
+++ b/tests/T8108.hs
@@ -1,8 +1,11 @@
-import Control.Monad
+module Main where
+
 import Control.Concurrent
-import System.Posix.User
+import Control.Monad
+import System.Posix
 
+main :: IO ()
 main = do
-    void $ forkIO $ forever $ getGroupEntryForID 0
-    void $ forkIO $ forever $ getGroupEntryForID 0
-    threadDelay (3*1000*1000)
+  void $ forkIO $ forever $ getGroupEntryForID 0
+  void $ forkIO $ forever $ getGroupEntryForID 0
+  threadDelay 3000000
diff --git a/tests/Terminal.hs b/tests/Terminal.hs
new file mode 100644
index 0000000000000000000000000000000000000000..b89750608e5b7076f3ba09d6bf95b70e12e72716
--- /dev/null
+++ b/tests/Terminal.hs
@@ -0,0 +1,15 @@
+module Main where
+
+import System.Posix
+import Test.Tasty.HUnit
+
+main :: IO ()
+main = do
+  (master, slave) <- openPseudoTerminal
+  orig <- getTerminalAttributes slave
+  let want = withInputSpeed orig B19200
+  setTerminalAttributes slave want Immediately
+  post <- getTerminalAttributes slave
+  closeFd slave
+  closeFd master
+  inputSpeed post @?= B19200
diff --git a/tests/Test.hs b/tests/Test.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9cb33770f6f51dd1d92bbd9b642af566c32b4719
--- /dev/null
+++ b/tests/Test.hs
@@ -0,0 +1,242 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-# OPTIONS_GHC -fno-warn-deprecations #-}
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+
+module Main (main) where
+
+import Control.Applicative
+import Control.Concurrent
+import qualified Control.Exception as E
+import Control.Monad
+import Data.List (sort)
+import System.Exit
+import System.IO
+import System.Posix
+import qualified System.Posix.Env.ByteString
+import Test.Tasty
+import Test.Tasty.HUnit
+
+import qualified FileStatus
+import qualified FileStatusByteString
+import qualified Signals001
+
+main :: IO ()
+main = defaultMain $ testGroup "All"
+  [ executeFile001
+  , fileExist01
+  , fileStatus
+  , fileStatusByteString
+  , getEnvironment01
+  , getEnvironment02
+  , getGroupEntry
+  , getUserEntry
+  , processGroup001
+  , processGroup002
+  , queryFdOption01
+  , signals001
+  , t1185
+  , t3816
+  , user001
+  , posix002
+  , posix005
+  , posix006
+  , posix010
+  ]
+
+executeFile001 :: TestTree
+executeFile001 = testCase "executeFile001" $ do
+  actual <- captureStdout $
+    executeFile "echo" True ["arg1", "ar   g2"] Nothing
+  actual @?= "arg1 ar   g2\n"
+
+fileExist01 :: TestTree
+fileExist01 = testCase "fileExist01" $ do
+  fileExist "."
+    @? "file should exist"
+  not <$> fileExist "does not exist"
+    @? "file should not exist"
+
+fileStatus :: TestTree
+fileStatus = testCase "fileStatus" FileStatus.main
+
+fileStatusByteString :: TestTree
+fileStatusByteString = testCase "fileStatusByteString" FileStatusByteString.main
+
+getEnvironment01 :: TestTree
+getEnvironment01 = testCase "getEnvironment01" $ do
+  env <- getEnvironment
+  not (null env)
+    @? "environment should be non-empty"
+
+getEnvironment02 :: TestTree
+getEnvironment02 = testCase "getEnvironment02" $ do
+  env <- System.Posix.Env.ByteString.getEnvironment
+  not (null env)
+    @? "environment should be non-empty"
+
+getGroupEntry :: TestTree
+getGroupEntry = testCase "getGroupEntry" $ do
+  let act = False <$ getGroupEntryForName "thisIsNotMeantToExist"
+  act `E.catch` (\(_ :: E.SomeException) -> return True)
+    @? "group should not exist"
+
+getUserEntry :: TestTree
+getUserEntry = testCase "getUserEntry" $ do
+  let act = False <$ getUserEntryForName "thisIsNotMeantToExist"
+  act `E.catch` (\(_ :: E.SomeException) -> return True)
+    @? "user should not exist"
+
+processGroup001 :: TestTree
+processGroup001 = testCase "processGroup001" $ do
+  pgid <- getProcessGroupID
+  pgid' <- getProcessGroupIDOf =<< getProcessID
+  pgid @?= pgid'
+
+processGroup002 :: TestTree
+processGroup002 = testCase "processGroup002" $ do
+  pid <- getProcessID
+  ppid <- getParentProcessID
+  ppgid <- getProcessGroupIDOf ppid
+  -- join the parent process
+  joinProcessGroup ppgid
+  pgid1 <- getProcessGroupID
+  ppgid @?= pgid1
+  -- be a leader
+  _ <- createProcessGroupFor pid
+  pgid2 <- getProcessGroupID
+  pid @?= fromIntegral pgid2
+  -- and join the parent again
+  setProcessGroupIDOf pid ppgid
+  pgid3 <- getProcessGroupID
+  ppgid @?= pgid3
+
+queryFdOption01 :: TestTree
+queryFdOption01 = testCase "queryFdOption01" $ do
+  not <$> queryFdOption stdOutput NonBlockingRead
+    @? "should be blocking"
+  setFdOption stdOutput NonBlockingRead True
+  queryFdOption stdOutput NonBlockingRead
+    @? "should be non-blocking"
+
+signals001 :: TestTree
+signals001 = testCase "signals001" Signals001.main
+
+t1185 :: TestTree
+t1185 = testCase "T1185" $ do
+  (stdinr, stdinw) <- createPipe
+  (stdoutr, stdoutw) <- createPipe
+  pid <- forkProcess $ do
+    hw <- fdToHandle stdoutw
+    hr <- fdToHandle stdinr
+    closeFd stdinw
+    hGetContents hr >>= hPutStr hw
+    hClose hr
+    hClose hw
+    exitImmediately ExitSuccess
+  threadDelay 100000
+  closeFd stdoutw
+  closeFd stdinw
+  hr2 <- fdToHandle stdoutr
+  hGetContents hr2 >>= putStr
+  actual <- getProcessStatus True False pid
+  actual @?= Just (Exited ExitSuccess)
+
+t3816 :: TestTree
+t3816 = testCase "T3816" $ do
+  not . null <$> getAllGroupEntries
+    @? "should be non-empty"
+  not . null <$> getAllGroupEntries
+    @? "should be non-empty"
+
+user001 :: TestTree
+user001 = testCase "user001" $ do
+  let force act = do
+        x <- act
+        x @?= x
+  force getRealUserID
+  force getRealUserID
+  force getRealGroupID
+  force getEffectiveUserID
+  force getEffectiveGroupID
+  force getGroups
+  force getEffectiveUserName
+  force $ getRealGroupID >>= getGroupEntryForID
+  force $ getRealGroupID >>= getGroupEntryForID >>= getGroupEntryForName . groupName
+  force getAllGroupEntries
+  force $ getRealUserID >>= getUserEntryForID
+  force getAllUserEntries
+
+posix002 :: TestTree
+posix002 = testCase "posix002" $ do
+  actual <- captureStdout $
+    executeFile "printenv" True [] (Just [("ONE","1"),("TWO","2")])
+  sort (lines actual) @?= ["ONE=1", "TWO=2"]
+
+posix005 :: TestTree
+posix005 = testCase "posix005" $ do
+    hSetBuffering stdout NoBuffering
+
+    setEnvironment [("one","1"),("two","2")]
+    env0 <- getEnvironment
+    sort env0 @?= [("one","1"),("two","2")]
+
+    setEnv "foo" "bar" True
+    env1 <- getEnvironment
+    sort env1 @?= [("foo","bar"),("one","1"),("two","2")]
+
+    setEnv "foo" "baz" True
+    env2 <- getEnvironment
+    sort env2 @?= [("foo","baz"),("one","1"),("two","2")]
+
+    setEnv "fu" "bar" True
+    env3 <- getEnvironment
+    sort env3 @?= [("foo","baz"),("fu","bar"),("one","1"),("two","2")]
+
+    unsetEnv "foo"
+    env4 <- getEnvironment
+    sort env4 @?= [("fu","bar"),("one","1"),("two","2")]
+
+    clearEnv
+    env5 <- getEnvironment
+    sort env5 @?= []
+
+posix006 :: TestTree
+posix006 = testCase "posix006" $ do
+  start <- epochTime
+  blockSignals reservedSignals -- see #4504
+  _ <- sleep 1
+  finish <- epochTime
+  let slept = finish - start
+  (slept >= 1 && slept <= 2)
+    @? "should have slept between 1 and 2"
+
+posix010 :: TestTree
+posix010 = testCase "posix010" $ do
+  root <- getUserEntryForName "root"
+  userName root    @?= "root"
+  userID root      @?= 0
+  userGroupID root @?= 0
+
+  root' <- getUserEntryForID (userID root)
+  userName root'    @?= "root"
+  userID root'      @?= 0
+  userGroupID root' @?= 0
+
+  homeDirectory root @?= homeDirectory root'
+
+-------------------------------------------------------------------------------
+-- Utils
+
+captureStdout :: IO () -> IO String
+captureStdout = captureFd stdOutput
+
+captureFd :: Fd -> IO () -> IO String
+captureFd fd act = do
+  (dRead, dWrite) <- createPipe
+  _ <- forkProcess $ do
+    _ <- dupTo dWrite fd
+    act
+  closeFd dWrite
+  handle <- fdToHandle dRead
+  hGetContents handle
diff --git a/tests/all.T b/tests/all.T
deleted file mode 100644
index 7b19365e67e5cc99cbee5468055e436f50ef5bba..0000000000000000000000000000000000000000
--- a/tests/all.T
+++ /dev/null
@@ -1,78 +0,0 @@
-
-test('signals001',  normal, compile_and_run, ['-package unix -cpp'])
-test('signals002', [], compile_and_run, ['-package unix'])
-test('fileexist01', normal, compile_and_run, ['-package unix'])
-
-# test #4512
-test('forkprocess01',
-     [extra_ways(['threaded1_ls']),
-      # the forked process breaks the .hp file
-      omit_ways(prof_ways)],
-     compile_and_run,
-     ['-package unix'])
-
-#
-# user001 may fail due to this bug in glibc:
-#   http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=466647
-#
-# Ticket #1487. The glibc implementation of getlogin, which is called by
-# getLoginName, requires that a terminal is connected to filedescriptor 0.
-# See: https://sourceware.org/git/?p=glibc.git;a=blob;f=sysdeps/unix/getlogin.c
-# Therefore we have to omit the 'ghci' way, because it relies on redirecting
-# stdin from file.
-#
-# But getLoginName also fails on GNU/Linux when using a terminal emulator
-# that doesn't write login records to /var/run/utmp. Running:
-#   $ logname
-# should print your login name. If it doesn't, the getLoginName test in user001
-# would fail, so we disabled that test.
-#
-test('user001', omit_ways(['ghci']), compile_and_run, ['-package unix'])
-test('resourceLimit', normal, compile_and_run, ['-package unix'])
-
-x86FreeBsdFail = when(platform('i386-unknown-freebsd'), expect_fail)
-
-test('queryfdoption01', [omit_ways(['ghci']), x86FreeBsdFail], compile_and_run,
-     ['-package unix'])
-test('getEnvironment01', x86FreeBsdFail, compile_and_run, ['-package unix'])
-test('getEnvironment02', x86FreeBsdFail, compile_and_run, ['-package unix'])
-test('getGroupEntryForName', [x86FreeBsdFail, exit_code(1)], compile_and_run,
-     ['-package unix'])
-test('getUserEntryForName', [x86FreeBsdFail, exit_code(1)], compile_and_run,
-     ['-package unix'])
-
-
-test('signals004', normal, compile_and_run, ['-package unix'])
-
-if ('threaded1' in config.run_ways):
-   only_threaded_ways = only_ways(['ghci','threaded1','threaded2'])
-else:
-   only_threaded_ways = skip
-
-test('fdReadBuf001', only_threaded_ways, compile_and_run, ['-package unix'])
-
-test('fileStatus',
-     extra_clean(['dir', 'regular', 'link-dir', 'link-regular']),
-     compile_and_run,
-     ['-package unix'])
-
-test('fileStatusByteString',
-     extra_clean(['dir', 'regular', 'link-dir', 'link-regular']),
-     compile_and_run,
-     ['-package unix'])
-
-
-test('T1185', normal, compile_and_run, ['-package unix'])
-
-# This test fails for me on x86/Linux with a "does not exist" error.
-# Running with strace shows it is trying to talk to winbindd (part of
-# Samba), so I think the failure has nothing to do with GHC.  Also it
-# works on a different machine that doesn't have Samba installed.
-#  --SDM 18/05/2010
-test('T3816', normal, compile_and_run, ['-package unix'])
-
-test('processGroup001', normal, compile_and_run, ['-package unix'])
-test('processGroup002', normal, compile_and_run, ['-package unix'])
-test('executeFile001', omit_ways(prof_ways + concurrent_ways), compile_and_run, ['-package unix'])
-
-test('T8108', normal, compile_and_run, ['-package unix'])
diff --git a/tests/executeFile001.hs b/tests/executeFile001.hs
deleted file mode 100644
index 7a70695b07cc56aeb57ffe90e7944424960b3c70..0000000000000000000000000000000000000000
--- a/tests/executeFile001.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-
-import System.Posix.Process
-
-main :: IO ()
-main = executeFile "echo" True ["arg1", "ar   g2"] Nothing
-
diff --git a/tests/executeFile001.stdout b/tests/executeFile001.stdout
deleted file mode 100644
index 9f4111c2dd30303958b07eb19fa3f31ba8f0aeda..0000000000000000000000000000000000000000
--- a/tests/executeFile001.stdout
+++ /dev/null
@@ -1 +0,0 @@
-arg1 ar   g2
diff --git a/tests/fileexist01.hs b/tests/fileexist01.hs
deleted file mode 100644
index 7bddda9af0b1cef3b8cb392f76bc944f7e6b4183..0000000000000000000000000000000000000000
--- a/tests/fileexist01.hs
+++ /dev/null
@@ -1,5 +0,0 @@
--- test System.Posix.fileExist
-import System.Posix
-main = do
-  fileExist "fileexist01.hs" >>= print
-  fileExist "does not exist" >>= print
diff --git a/tests/fileexist01.stdout b/tests/fileexist01.stdout
deleted file mode 100644
index 1cc8b5e10d332579303311a121b2c33c1d9c9f9a..0000000000000000000000000000000000000000
--- a/tests/fileexist01.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-True
-False
diff --git a/tests/forkprocess01.hs b/tests/forkprocess01.hs
deleted file mode 100644
index bc182c53afeb311a88e840c2067e2fa7247b7225..0000000000000000000000000000000000000000
--- a/tests/forkprocess01.hs
+++ /dev/null
@@ -1,9 +0,0 @@
--- Test that we can call exitFailure in a forked process, and have it
--- communicated properly to the parent.
-import System.Exit
-import System.Posix.Process
-main = do
-  p <- forkProcess $ exitWith (ExitFailure 72)
-  r <- getProcessStatus True False p
-  print r
-
diff --git a/tests/forkprocess01.stdout b/tests/forkprocess01.stdout
deleted file mode 100644
index 3c10134ade4343582e784e1e998636fd08b3e7ce..0000000000000000000000000000000000000000
--- a/tests/forkprocess01.stdout
+++ /dev/null
@@ -1 +0,0 @@
-Just (Exited (ExitFailure 72))
diff --git a/tests/getEnvironment01.hs b/tests/getEnvironment01.hs
deleted file mode 100644
index fb50fab5be1487e40dd7ed7e7bfb12cbc7b3854a..0000000000000000000000000000000000000000
--- a/tests/getEnvironment01.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-
--- test for trac #781 (GHCi on x86_64, cannot link to static data in
--- shared libs)
-
-import System.Posix.Env
-
-main = getEnvironment >>= (print . (0 <=) . length)
-
diff --git a/tests/getEnvironment01.stdout b/tests/getEnvironment01.stdout
deleted file mode 100644
index 0ca95142bb715442d0c2c82a7c573a08c4593845..0000000000000000000000000000000000000000
--- a/tests/getEnvironment01.stdout
+++ /dev/null
@@ -1 +0,0 @@
-True
diff --git a/tests/getEnvironment02.hs b/tests/getEnvironment02.hs
deleted file mode 100644
index be920df3985ad974f3ed6eaa5648baf110c8f22d..0000000000000000000000000000000000000000
--- a/tests/getEnvironment02.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-
--- test for trac #781 (GHCi on x86_64, cannot link to static data in
--- shared libs)
-
-import System.Posix.Env.ByteString
-
-main = getEnvironment >>= (print . (0 <=) . length)
-
diff --git a/tests/getEnvironment02.stdout b/tests/getEnvironment02.stdout
deleted file mode 100644
index 0ca95142bb715442d0c2c82a7c573a08c4593845..0000000000000000000000000000000000000000
--- a/tests/getEnvironment02.stdout
+++ /dev/null
@@ -1 +0,0 @@
-True
diff --git a/tests/getGroupEntryForName.hs b/tests/getGroupEntryForName.hs
deleted file mode 100644
index bdb42722685f86650dadd6d6be8df30c99994f1b..0000000000000000000000000000000000000000
--- a/tests/getGroupEntryForName.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-
-import System.Posix.User
-
-main :: IO ()
-main = getGroupEntryForName "thisIsNotMeantToExist" >> return ()
diff --git a/tests/getGroupEntryForName.stderr b/tests/getGroupEntryForName.stderr
deleted file mode 100644
index 9a2679fc96de330298f0e2e87817bf160f0a4b6a..0000000000000000000000000000000000000000
--- a/tests/getGroupEntryForName.stderr
+++ /dev/null
@@ -1 +0,0 @@
-getGroupEntryForName: getGroupEntryForName: does not exist (no such group)
diff --git a/tests/getUserEntryForName.hs b/tests/getUserEntryForName.hs
deleted file mode 100644
index a31566e9ce62122b7861f9245915d1bf71c70522..0000000000000000000000000000000000000000
--- a/tests/getUserEntryForName.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-
-import System.Posix.User
-
-main :: IO ()
-main = getUserEntryForName "thisIsNotMeantToExist" >> return ()
diff --git a/tests/getUserEntryForName.stderr b/tests/getUserEntryForName.stderr
deleted file mode 100644
index 0a941d94f25fd32e8fe416e955f921a868a0c7d3..0000000000000000000000000000000000000000
--- a/tests/getUserEntryForName.stderr
+++ /dev/null
@@ -1 +0,0 @@
-getUserEntryForName: getUserEntryForName: does not exist (no such user)
diff --git a/tests/libposix/Makefile b/tests/libposix/Makefile
deleted file mode 100644
index 4ca77510701c80326915a18bd6729824bbc1ca65..0000000000000000000000000000000000000000
--- a/tests/libposix/Makefile
+++ /dev/null
@@ -1,7 +0,0 @@
-# This Makefile runs the tests using GHC's testsuite framework.  It
-# assumes the package is part of a GHC build tree with the testsuite
-# installed in ../../../testsuite.
-
-TOP=../../../../testsuite
-include $(TOP)/mk/boilerplate.mk
-include $(TOP)/mk/test.mk
diff --git a/tests/libposix/all.T b/tests/libposix/all.T
deleted file mode 100644
index fc4840c0566f3569c0cf8ed31afb703918c714c2..0000000000000000000000000000000000000000
--- a/tests/libposix/all.T
+++ /dev/null
@@ -1,19 +0,0 @@
-setTestOpts(when(opsys('mingw32'), skip))
-
-test('posix002', [ omit_ways(prof_ways), fragile_for(16550, concurrent_ways) ],
-                 compile_and_run, [''])
-
-# Skip on mingw32: assumes existence of 'pwd' and /tmp
-test('posix003', [extra_clean(['po003.out'])],
-                 compile_and_run, [''])
-
-test('posix004', [ ], compile_and_run, [''])
-
-test('posix005', [ ], compile_and_run, [''])
-
-test('posix006', normal , compile_and_run, [''])
-test('posix009', [ omit_ways(threaded_ways) ], compile_and_run, [''])
-test('posix010', normal, compile_and_run, [''])
-
-test('posix014', [ omit_ways(prof_ways) ],
-                 compile_and_run, [''])
diff --git a/tests/libposix/posix002.hs b/tests/libposix/posix002.hs
deleted file mode 100644
index c5909abd6f6097446799b38a748aa819384d218e..0000000000000000000000000000000000000000
--- a/tests/libposix/posix002.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-import System.Posix.Process
-
-main =
-    executeFile "printenv" True [] (Just [("ONE","1"),("TWO","2")])
diff --git a/tests/libposix/posix002.stdout b/tests/libposix/posix002.stdout
deleted file mode 100644
index 5e17a60f42fc2af04dba36993ba1c203f0d29e59..0000000000000000000000000000000000000000
--- a/tests/libposix/posix002.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-ONE=1
-TWO=2
diff --git a/tests/libposix/posix003.hs b/tests/libposix/posix003.hs
deleted file mode 100644
index b28f9f7dbf3f45ed82b977d9266f974220330494..0000000000000000000000000000000000000000
--- a/tests/libposix/posix003.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-
-import Control.Monad
-import Data.Char
-import System.Exit
-import System.IO
-import System.Process
-
-main = do hw <- openFile "po003.out" WriteMode
-          ph <- runProcess "pwd" [] (Just "/dev") Nothing Nothing (Just hw) Nothing
-          ec <- waitForProcess ph
-          hClose hw
-          unless (ec == ExitSuccess) $ error "pwd failed"
-          hr <- openFile "po003.out" ReadMode
-          output <- hGetContents hr
-          putStrLn ("Got: " ++ show (filter (not . isSpace) output))
-          hClose hr
-
diff --git a/tests/libposix/posix003.stdout b/tests/libposix/posix003.stdout
deleted file mode 100644
index 5206ef3c222fe5c1791bb4da87c22df5c004df11..0000000000000000000000000000000000000000
--- a/tests/libposix/posix003.stdout
+++ /dev/null
@@ -1 +0,0 @@
-Got: "/dev"
diff --git a/tests/libposix/posix004.stdout b/tests/libposix/posix004.stdout
deleted file mode 100644
index 8ed7ee54d5bac70c81324f7abaea69567f731bc4..0000000000000000000000000000000000000000
--- a/tests/libposix/posix004.stdout
+++ /dev/null
@@ -1 +0,0 @@
-I'm happy.
diff --git a/tests/libposix/posix005.hs b/tests/libposix/posix005.hs
deleted file mode 100644
index 91331ff570399a175acdcc00bdc86b5c28a145e2..0000000000000000000000000000000000000000
--- a/tests/libposix/posix005.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-import Data.List (sort)
-import System.IO
-import System.Posix.Env
-
-printEnv :: IO ()
-printEnv = getEnvironment >>= print . sort
-
-main = do
-    hSetBuffering stdout NoBuffering
-    term <- getEnv "TERM"
-    maybe (return ()) putStrLn term
-    setEnvironment [("one","1"),("two","2")]
-    printEnv
-    setEnv "foo" "bar" True
-    printEnv
-    setEnv "foo" "baz" True
-    printEnv
-    setEnv "fu" "bar" True
-    printEnv
-    unsetEnv "foo"
-    printEnv
-    clearEnv
-    printEnv
-
diff --git a/tests/libposix/posix005.stdout b/tests/libposix/posix005.stdout
deleted file mode 100644
index 4f6005430bc90a4b32e3f0ab609501f2b0cd871a..0000000000000000000000000000000000000000
--- a/tests/libposix/posix005.stdout
+++ /dev/null
@@ -1,7 +0,0 @@
-vt100
-[("one","1"),("two","2")]
-[("foo","bar"),("one","1"),("two","2")]
-[("foo","baz"),("one","1"),("two","2")]
-[("foo","baz"),("fu","bar"),("one","1"),("two","2")]
-[("fu","bar"),("one","1"),("two","2")]
-[]
diff --git a/tests/libposix/posix006.hs b/tests/libposix/posix006.hs
deleted file mode 100644
index 697e4e6e209358b30a955ac0dea13780d929db0a..0000000000000000000000000000000000000000
--- a/tests/libposix/posix006.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-
-import System.Posix.Time
-import System.Posix.Unistd
-import System.Posix.Signals
-
-main = do start <- epochTime
-          blockSignals reservedSignals -- see #4504
-          sleep 1
-          finish <- epochTime
-          let slept = finish - start
-          if slept >= 1 && slept <= 2
-              then putStrLn "OK"
-              else do putStr "Started: "
-                      print start
-                      putStr "Finished: "
-                      print finish
-                      putStr "Slept: "
-                      print slept
diff --git a/tests/libposix/posix006.stdout b/tests/libposix/posix006.stdout
deleted file mode 100644
index d86bac9de59abcc26bc7956c1e842237c7581859..0000000000000000000000000000000000000000
--- a/tests/libposix/posix006.stdout
+++ /dev/null
@@ -1 +0,0 @@
-OK
diff --git a/tests/libposix/posix009.hs b/tests/libposix/posix009.hs
deleted file mode 100644
index 067d3a9f298a1989f275e54e9afcfbf36b93317c..0000000000000000000000000000000000000000
--- a/tests/libposix/posix009.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-import System.Posix.Signals
-import System.Posix.Unistd
-
-main = do
-    putStrLn "Blocking real time alarms."
-    blockSignals (addSignal realTimeAlarm reservedSignals)
-    putStrLn "Scheduling an alarm in 2 seconds..."
-    scheduleAlarm 2
-    putStrLn "Sleeping 5 seconds."
-    sleep 5
-    putStrLn "Woken up"
-    ints <- getPendingSignals
-    putStrLn "Checking pending interrupts for RealTimeAlarm"
-    print (inSignalSet realTimeAlarm ints)
-
diff --git a/tests/libposix/posix009.stdout b/tests/libposix/posix009.stdout
deleted file mode 100644
index d2946753e219bcc4098387e4ed635fb89369f985..0000000000000000000000000000000000000000
--- a/tests/libposix/posix009.stdout
+++ /dev/null
@@ -1,6 +0,0 @@
-Blocking real time alarms.
-Scheduling an alarm in 2 seconds...
-Sleeping 5 seconds.
-Woken up
-Checking pending interrupts for RealTimeAlarm
-True
diff --git a/tests/libposix/posix010.hs b/tests/libposix/posix010.hs
deleted file mode 100644
index 420d2107fa17f7411ff780c0da712065e7d30c12..0000000000000000000000000000000000000000
--- a/tests/libposix/posix010.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-import System.Posix
-
-main = do
-    root <- getUserEntryForName "root"
-    putStrLn (ue2String root)
-    root' <- getUserEntryForID (userID root)
-    putStrLn (ue2String root')
-    if homeDirectory root == homeDirectory root' &&
-       userShell     root == userShell     root'
-        then putStrLn "OK"
-        else putStrLn "Mismatch"
-
-ue2String ue = concat [name, ":", show uid, ":", show gid]
-    where name = userName ue
-          uid = userID ue
-          gid = userGroupID ue
diff --git a/tests/libposix/posix010.stdout b/tests/libposix/posix010.stdout
deleted file mode 100644
index 77a50244985e191bafc1e77f627e420b16b648aa..0000000000000000000000000000000000000000
--- a/tests/libposix/posix010.stdout
+++ /dev/null
@@ -1,3 +0,0 @@
-root:0:0
-root:0:0
-OK
diff --git a/tests/libposix/posix014.hs b/tests/libposix/posix014.hs
deleted file mode 100644
index 9d844b20ce297a60ac8b21667af272896341041d..0000000000000000000000000000000000000000
--- a/tests/libposix/posix014.hs
+++ /dev/null
@@ -1,13 +0,0 @@
--- !! Basic pipe usage
-module Main (main) where
-
-import System.Posix
-
-main = do
-  (rd, wd) <- createPipe
-  pid <- forkProcess $ do (str, _) <- fdRead rd 32
-                          putStrLn str
-  fdWrite wd "Hi, there - forked child calling"
-  getProcessStatus True False pid
-  return ()
-
diff --git a/tests/libposix/posix014.stdout b/tests/libposix/posix014.stdout
deleted file mode 100644
index cab0a57734f792096e2dcf110454ea58fbd7ed46..0000000000000000000000000000000000000000
--- a/tests/libposix/posix014.stdout
+++ /dev/null
@@ -1 +0,0 @@
-Hi, there - forked child calling
diff --git a/tests/processGroup001.hs b/tests/processGroup001.hs
deleted file mode 100644
index cd9f70b739a698c128de7ffa1e85aacab6beb3bd..0000000000000000000000000000000000000000
--- a/tests/processGroup001.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-import System.Posix.Process
-
-main = do
-	pgid <- getProcessGroupID
-	pgid' <- getProcessGroupIDOf =<< getProcessID
-	putStr "Testing getProcessGroupID == getProcessGroupIDOf =<< getProcessID: "
-	print $ pgid == pgid'
diff --git a/tests/processGroup001.stdout b/tests/processGroup001.stdout
deleted file mode 100644
index b9be50f310a45ad7233b7b4993a4396cd0e5e034..0000000000000000000000000000000000000000
--- a/tests/processGroup001.stdout
+++ /dev/null
@@ -1 +0,0 @@
-Testing getProcessGroupID == getProcessGroupIDOf =<< getProcessID: True
diff --git a/tests/processGroup002.hs b/tests/processGroup002.hs
deleted file mode 100644
index c93a4168b2df7b9ece36d0fa20fec73ca118a2b8..0000000000000000000000000000000000000000
--- a/tests/processGroup002.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-import System.Posix.Process
-
-main = do
-	pid <- getProcessID
-	ppid <- getParentProcessID
-	ppgid <- getProcessGroupIDOf ppid
-	-- join the parent process
-	putStr "Testing joinProcessGroup: "
-	joinProcessGroup ppgid
-	pgid1 <- getProcessGroupID
-	print $ ppgid == pgid1
-	-- be a leader
-	putStr "Testing createProcessGroupFor: "
-	createProcessGroupFor pid
-	pgid2 <- getProcessGroupID
-	print $ pid == fromIntegral pgid2
-	-- and join the parent again
-	putStr "Testing setProcessGroupIDOf: "
-	setProcessGroupIDOf pid ppgid
-	pgid3 <- getProcessGroupID
-	print $ ppgid == pgid3
diff --git a/tests/processGroup002.stdout b/tests/processGroup002.stdout
deleted file mode 100644
index b9d2409ab0a581a8fcf755d896efb6df27f10a92..0000000000000000000000000000000000000000
--- a/tests/processGroup002.stdout
+++ /dev/null
@@ -1,3 +0,0 @@
-Testing joinProcessGroup: True
-Testing createProcessGroupFor: True
-Testing setProcessGroupIDOf: True
diff --git a/tests/queryfdoption01.hs b/tests/queryfdoption01.hs
deleted file mode 100644
index 46833c105fd97d850371d487da6c7d4f1222429d..0000000000000000000000000000000000000000
--- a/tests/queryfdoption01.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-import System.Posix.IO
-import System.IO
-
-showNBR = do
-	v <- System.Posix.IO.queryFdOption 0 System.Posix.IO.NonBlockingRead
-	putStr $ "NonBlockingRead = " ++ (show v) ++ "\n"
-
-main = do
-	showNBR
-	System.Posix.IO.setFdOption 0 System.Posix.IO.NonBlockingRead True
-	showNBR
diff --git a/tests/queryfdoption01.stdin b/tests/queryfdoption01.stdin
deleted file mode 100644
index 0e9d79c36c8cda75230525e28afce2ac12f9f95c..0000000000000000000000000000000000000000
--- a/tests/queryfdoption01.stdin
+++ /dev/null
@@ -1,3 +0,0 @@
-You can't fcntl(fd, F_SETFL, O_NONBLOCK) /dev/null on (Open)BSD,
-so just supply this dummy file instead of running this test on
-/dev/null.
diff --git a/tests/queryfdoption01.stdout b/tests/queryfdoption01.stdout
deleted file mode 100644
index 1ed43b583e23320cc5b865204991357e79056327..0000000000000000000000000000000000000000
--- a/tests/queryfdoption01.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-NonBlockingRead = False
-NonBlockingRead = True
diff --git a/tests/resourceLimit.hs b/tests/resourceLimit.hs
deleted file mode 100644
index 05e35afcc07e4fb6afe14a3d9c84ae93c78ce0df..0000000000000000000000000000000000000000
--- a/tests/resourceLimit.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-
--- #2038
-
-import System.Posix.Resource
-
-main :: IO ()
-main = do
-    let soft = ResourceLimit 5
-        hard = ResourceLimit 10
-    setResourceLimit ResourceCPUTime (ResourceLimits soft hard)
-    r <- getResourceLimit ResourceCPUTime
-    let (ResourceLimit s) = softLimit r
-    let (ResourceLimit h) = hardLimit r
-    putStrLn $ show s
-    putStrLn $ show h
-
diff --git a/tests/resourceLimit.stdout b/tests/resourceLimit.stdout
deleted file mode 100644
index c3ec80144cb1009fbead397836eade7cf19df5e5..0000000000000000000000000000000000000000
--- a/tests/resourceLimit.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-5
-10
diff --git a/tests/signals001.hs b/tests/signals001.hs
deleted file mode 100644
index 20c1d89631a6dd771335ee06722039e02157e5fe..0000000000000000000000000000000000000000
--- a/tests/signals001.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-import System.Posix.Signals
-
-#include "ghcconfig.h"
-
-main = do
-  print (testMembers emptySignalSet)
-  print (testMembers emptyset)
-  print (testMembers fullSignalSet)
-  print (testMembers fullset)
-
-fullset = internalAbort `addSignal`
-	  realTimeAlarm `addSignal`
-	  busError `addSignal`
-	  processStatusChanged `addSignal`
-	  continueProcess `addSignal`
-	  floatingPointException `addSignal`
-	  lostConnection `addSignal`
-	  illegalInstruction `addSignal`
-	  keyboardSignal `addSignal`
-	  killProcess `addSignal`
-	  openEndedPipe `addSignal`
-	  keyboardTermination `addSignal`
-	  segmentationViolation `addSignal`
-	  softwareStop `addSignal`
-	  softwareTermination `addSignal`
-	  keyboardStop `addSignal`
-	  backgroundRead `addSignal`
-	  backgroundWrite `addSignal`
-	  userDefinedSignal1 `addSignal`
-	  userDefinedSignal2 `addSignal`
-#if HAVE_SIGPOLL
-	  pollableEvent `addSignal`
-#endif
-	  profilingTimerExpired `addSignal`
-	  badSystemCall `addSignal`
-	  breakpointTrap `addSignal`
-	  urgentDataAvailable `addSignal`
-	  virtualTimerExpired `addSignal`
-	  cpuTimeLimitExceeded `addSignal`
-	  fileSizeLimitExceeded `addSignal`
-	  emptySignalSet
-
-emptyset = internalAbort `deleteSignal`
-	  realTimeAlarm `deleteSignal`
-	  busError `deleteSignal`
-	  processStatusChanged `deleteSignal`
-	  continueProcess `deleteSignal`
-	  floatingPointException `deleteSignal`
-	  lostConnection `deleteSignal`
-	  illegalInstruction `deleteSignal`
-	  keyboardSignal `deleteSignal`
-	  killProcess `deleteSignal`
-	  openEndedPipe `deleteSignal`
-	  keyboardTermination `deleteSignal`
-	  segmentationViolation `deleteSignal`
-	  softwareStop `deleteSignal`
-	  softwareTermination `deleteSignal`
-	  keyboardStop `deleteSignal`
-	  backgroundRead `deleteSignal`
-	  backgroundWrite `deleteSignal`
-	  userDefinedSignal1 `deleteSignal`
-	  userDefinedSignal2 `deleteSignal`
-#if HAVE_SIGPOLL
-	  pollableEvent `deleteSignal`
-#endif
-	  profilingTimerExpired `deleteSignal`
-	  badSystemCall `deleteSignal`
-	  breakpointTrap `deleteSignal`
-	  urgentDataAvailable `deleteSignal`
-	  virtualTimerExpired `deleteSignal`
-	  cpuTimeLimitExceeded `deleteSignal`
-	  fileSizeLimitExceeded `deleteSignal`
-	  fullSignalSet
-  
-testMembers set = [
-	  internalAbort `inSignalSet` set,
-	  realTimeAlarm `inSignalSet` set,
-	  busError `inSignalSet` set,
-	  processStatusChanged `inSignalSet` set,
-	  continueProcess `inSignalSet` set,
-	  floatingPointException `inSignalSet` set,
-	  lostConnection `inSignalSet` set,
-	  illegalInstruction `inSignalSet` set,
-	  keyboardSignal `inSignalSet` set,
-	  killProcess `inSignalSet` set,
-	  openEndedPipe `inSignalSet` set,
-	  keyboardTermination `inSignalSet` set,
-	  segmentationViolation `inSignalSet` set,
-	  softwareStop `inSignalSet` set,
-	  softwareTermination `inSignalSet` set,
-	  keyboardStop `inSignalSet` set,
-	  backgroundRead `inSignalSet` set,
-	  backgroundWrite `inSignalSet` set,
-	  userDefinedSignal1 `inSignalSet` set,
-	  userDefinedSignal2 `inSignalSet` set,
-#if HAVE_SIGPOLL
-	  pollableEvent `inSignalSet` set,
-#endif
-	  profilingTimerExpired `inSignalSet` set,
-	  badSystemCall `inSignalSet` set,
-	  breakpointTrap `inSignalSet` set,
-	  urgentDataAvailable `inSignalSet` set,
-	  virtualTimerExpired `inSignalSet` set,
-	  cpuTimeLimitExceeded `inSignalSet` set,
-	  fileSizeLimitExceeded `inSignalSet` set
-    ]
diff --git a/tests/signals001.stdout b/tests/signals001.stdout
deleted file mode 100644
index b90d1f35c6c3c999558c7dab17174c2858417934..0000000000000000000000000000000000000000
--- a/tests/signals001.stdout
+++ /dev/null
@@ -1,4 +0,0 @@
-[False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False]
-[False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False]
-[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
-[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
diff --git a/tests/signals001.stdout-i386-unknown-freebsd b/tests/signals001.stdout-i386-unknown-freebsd
deleted file mode 100644
index b90d1f35c6c3c999558c7dab17174c2858417934..0000000000000000000000000000000000000000
--- a/tests/signals001.stdout-i386-unknown-freebsd
+++ /dev/null
@@ -1,4 +0,0 @@
-[False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False]
-[False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False]
-[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
-[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
diff --git a/tests/signals001.stdout-i386-unknown-openbsd b/tests/signals001.stdout-i386-unknown-openbsd
deleted file mode 100644
index b90d1f35c6c3c999558c7dab17174c2858417934..0000000000000000000000000000000000000000
--- a/tests/signals001.stdout-i386-unknown-openbsd
+++ /dev/null
@@ -1,4 +0,0 @@
-[False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False]
-[False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False]
-[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
-[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
diff --git a/tests/signals001.stdout-sparc-unknown-openbsd b/tests/signals001.stdout-sparc-unknown-openbsd
deleted file mode 100644
index b90d1f35c6c3c999558c7dab17174c2858417934..0000000000000000000000000000000000000000
--- a/tests/signals001.stdout-sparc-unknown-openbsd
+++ /dev/null
@@ -1,4 +0,0 @@
-[False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False]
-[False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False]
-[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
-[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
diff --git a/tests/signals001.stdout-x86_64-unknown-openbsd b/tests/signals001.stdout-x86_64-unknown-openbsd
deleted file mode 100644
index b90d1f35c6c3c999558c7dab17174c2858417934..0000000000000000000000000000000000000000
--- a/tests/signals001.stdout-x86_64-unknown-openbsd
+++ /dev/null
@@ -1,4 +0,0 @@
-[False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False]
-[False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False,False]
-[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
-[True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True,True]
diff --git a/tests/signals002.stdout b/tests/signals002.stdout
deleted file mode 100644
index 8e3dc9e5539e4994091aea69af24ddbf557241b1..0000000000000000000000000000000000000000
--- a/tests/signals002.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-True
-hello
diff --git a/tests/user001.hs b/tests/user001.hs
deleted file mode 100644
index 4b4dd8bde09c8dd657653d13fbd13e7c7fdb6e8d..0000000000000000000000000000000000000000
--- a/tests/user001.hs
+++ /dev/null
@@ -1,27 +0,0 @@
--- test that none of System.Posix.User.get* fail
-import Control.Exception as Exception
-import System.Posix.User
-
-check :: Show a => a -> Bool
-check a = show a == show a
-
-p :: Show a => String -> IO a -> IO ()
-p s m = (do putStr (s ++ ": ")
-            c <- fmap check m
-            putStrLn $ if c then "OK" else "I am the pope!")
-        `Exception.catch` (\e -> putStrLn ("ERROR: " ++ show (e::SomeException)))
-
-main :: IO ()
-main = do p "getRealUserID"        $ getRealUserID
-          p "getRealGroupID"       $ getRealGroupID
-          p "getEffectiveUserID"   $ getEffectiveUserID
-          p "getEffectiveGroupID"  $ getEffectiveGroupID
-          p "getGroups"            $ getGroups
-          --p "getLoginName"         $ getLoginName
-          p "getEffectiveUserName" $ getEffectiveUserName
-          p "getGroupEntryForID"   $ getRealGroupID >>= getGroupEntryForID
-          p "getGroupEntryForName" $ getRealGroupID >>= getGroupEntryForID >>= getGroupEntryForName . groupName
-          p "getAllGroupEntries"   $ getAllGroupEntries
-          p "getUserEntryForID"    $ getRealUserID >>= getUserEntryForID
-          --p "getUserEntryForName"  $ getLoginName >>= getUserEntryForName
-          p "getAllUserEntries"    $ getAllUserEntries
diff --git a/tests/user001.stdout b/tests/user001.stdout
deleted file mode 100644
index e2e03df1356f52db1899b25deba7909875828d8f..0000000000000000000000000000000000000000
--- a/tests/user001.stdout
+++ /dev/null
@@ -1,11 +0,0 @@
-getRealUserID: OK
-getRealGroupID: OK
-getEffectiveUserID: OK
-getEffectiveGroupID: OK
-getGroups: OK
-getEffectiveUserName: OK
-getGroupEntryForID: OK
-getGroupEntryForName: OK
-getAllGroupEntries: OK
-getUserEntryForID: OK
-getAllUserEntries: OK
diff --git a/unix.cabal b/unix.cabal
index 9651f24b0051f521becc16d3d9d4c2a64754f56b..f0591f2b447784d46693db24ba746a3ef9b7f4cc 100644
--- a/unix.cabal
+++ b/unix.cabal
@@ -1,5 +1,5 @@
 name:           unix
-version:        2.7.2.2
+version:        2.7.3
 -- NOTE: Don't forget to update ./changelog.md
 license:        BSD3
 license-file:   LICENSE
@@ -62,7 +62,7 @@ library
         buildable: False
 
     build-depends:
-        base        >= 4.5     && < 4.18,
+        base        >= 4.10    && < 4.18,
         bytestring  >= 0.9.2   && < 0.12,
         time        >= 1.2     && < 1.13
 
@@ -132,3 +132,111 @@ library
     c-sources:
         cbits/HsUnix.c
         cbits/execvpe.c
+
+test-suite unix-tests
+    hs-source-dirs: tests
+    main-is: Test.hs
+    other-modules:
+        FileStatus
+        FileStatusByteString
+        Signals001
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, tasty, tasty-hunit, unix
+    ghc-options: -Wall -with-rtsopts=-V0
+
+test-suite FdReadBuf001
+    hs-source-dirs: tests
+    main-is: FdReadBuf001.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix
+    ghc-options: -Wall -threaded
+
+test-suite ForkProcess01
+    hs-source-dirs: tests
+    main-is: ForkProcess01.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix
+    ghc-options: -Wall
+
+test-suite Signals002
+    hs-source-dirs: tests
+    main-is: Signals002.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix
+    ghc-options: -Wall
+
+test-suite Signals004
+    hs-source-dirs: tests
+    main-is: Signals004.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix
+    ghc-options: -Wall
+
+test-suite Posix004
+    hs-source-dirs: tests
+    main-is: Posix004.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix
+    ghc-options: -Wall
+
+test-suite Posix009
+    hs-source-dirs: tests
+    main-is: Posix009.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix
+    ghc-options: -Wall -with-rtsopts=-V0
+
+test-suite Posix014
+    hs-source-dirs: tests
+    main-is: Posix014.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix
+    ghc-options: -Wall
+
+test-suite T8108
+    hs-source-dirs: tests
+    main-is: T8108.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix
+    ghc-options: -Wall
+
+test-suite ResourceLimit
+    hs-source-dirs: tests
+    main-is: ResourceLimit.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix, tasty-hunit
+    ghc-options: -Wall
+
+test-suite Terminal
+    hs-source-dirs: tests
+    main-is: Terminal.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix, tasty-hunit
+    ghc-options: -Wall
+
+test-suite PutEnv001
+    hs-source-dirs: tests
+    main-is: PutEnv001.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix, tasty, tasty-hunit
+    ghc-options: -Wall -with-rtsopts=-V0 -O0
+
+test-suite Semaphore001
+    hs-source-dirs: tests
+    main-is: Semaphore001.hs
+    type: exitcode-stdio-1.0
+    default-language: Haskell2010
+    build-depends: base, unix
+    ghc-options: -Wall