[commit: packages/process] master: Test relative paths in subdirectories (fc06dff)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/process

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/fc06dff1986d7420190ecbb4a289f2f087a1671f/process

>---------------------------------------------------------------

commit fc06dff1986d7420190ecbb4a289f2f087a1671f
Author: Michael Snoyman <michael at snoyman.com>
Date:   Sun Nov 13 11:38:04 2016 +0200

    Test relative paths in subdirectories


>---------------------------------------------------------------

fc06dff1986d7420190ecbb4a289f2f087a1671f
 exes/echo.bat        |  1 +
 exes/subdir/echo.bat |  1 +
 process.cabal        |  3 +++
 test/main.hs         | 21 +++++++++++++++++++++
 4 files changed, 26 insertions(+)

diff --git a/exes/echo.bat b/exes/echo.bat
new file mode 100755
index 0000000..2699c07
--- /dev/null
+++ b/exes/echo.bat
@@ -0,0 +1 @@
+echo parent
diff --git a/exes/subdir/echo.bat b/exes/subdir/echo.bat
new file mode 100755
index 0000000..52091e8
--- /dev/null
+++ b/exes/subdir/echo.bat
@@ -0,0 +1 @@
+echo child
diff --git a/process.cabal b/process.cabal
index ee79452..a0c72fb 100644
--- a/process.cabal
+++ b/process.cabal
@@ -19,6 +19,8 @@ extra-source-files:
     configure.ac
     include/HsProcessConfig.h.in
     process.buildinfo
+    exes/echo.bat
+    exes/subdir/echo.bat
 
 extra-tmp-files:
     autom4te.cache
@@ -81,4 +83,5 @@ test-suite test
   main-is: main.hs
   type: exitcode-stdio-1.0
   build-depends: base
+               , directory
                , process
diff --git a/test/main.hs b/test/main.hs
index 40558b2..c47838e 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -1,6 +1,8 @@
 import Control.Exception
+import Control.Monad (unless)
 import System.Exit
 import System.IO.Error
+import System.Directory (getCurrentDirectory, setCurrentDirectory)
 import System.Process
 
 main :: IO ()
@@ -27,4 +29,23 @@ main = do
     test "create_new_console" $ \cp -> cp { create_new_console = True }
     test "new_session" $ \cp -> cp { new_session = True }
 
+    putStrLn "Testing subdirectories"
+
+    withCurrentDirectory "exes" $ do
+      res <- readCreateProcess (proc "./echo.bat" []) ""
+      unless (res == "parent\n") $ error $
+        "echo.bat with cwd failed: " ++ show res
+
+      res <- readCreateProcess (proc "./echo.bat" []) { cwd = Just "subdir" } ""
+      unless (res == "child\n") $ error $
+        "echo.bat with cwd failed: " ++ show res
+
     putStrLn "Tests passed successfully"
+
+withCurrentDirectory :: FilePath -> IO a -> IO a
+withCurrentDirectory new inner = do
+  orig <- getCurrentDirectory
+  bracket_
+    (setCurrentDirectory new)
+    (setCurrentDirectory orig)
+    inner