Merge pull request #296 from neilmayhew/no-cwd-segfault-mac

Prevent a segfault in createProcess on Mac

cbits/posix/find_executable.c

@@ -53,10 +53,12 @@ static bool is_executable(char *working_dir, const char *path) {
  * found.
   */
 static char *find_in_search_path(char *working_dir, char *search_path, const char *filename) {
-    int workdir_len = strlen(working_dir);
     const int filename_len = strlen(filename);
     char *tokbuf;
     char *path = strtok_r(search_path, ":", &tokbuf);
+    if (!working_dir)
+        working_dir = ".";
+    int workdir_len = strlen(working_dir);
     while (path != NULL) {
 	// N.B. gcc 6.3.0, used by Debian 9, inexplicably warns that `path`
 	// may not be initialised with -Wall.  Silence this warning. See #210.

test/main.hs

@@ -41,6 +41,7 @@ main = do
     testInterruptWith
     testDoubleWait
     testKillDoubleWait
+    testCreateProcess
     putStrLn ">>> Tests passed successfully"
 
 run :: String -> IO () -> IO ()
@@ -251,6 +252,33 @@ testKillDoubleWait = unless isWindows $ do
         ("INT", True) -> checkFirst "INT" False res
         _ -> checkFirst sig delegate res
 
+-- Test that createProcess doesn't segfault on Mac with a cwd of Nothing
+testCreateProcess :: IO ()
+testCreateProcess = run "createProcess with cwd = Nothing" $ do
+    let env = CreateProcess
+            { child_group = Nothing
+            , child_user = Nothing
+            , close_fds = False
+            , cmdspec = RawCommand "env" []
+            , create_group = True
+            , create_new_console = False
+            , cwd = Nothing
+            , delegate_ctlc = False
+            , detach_console = False
+            , env = Just [("PATH", "/bin:/usr/bin")]
+            , new_session = False
+            , std_err = Inherit
+            , std_in = Inherit
+            , std_out = Inherit
+            , use_process_jobs = False
+            }
+    (_, _, _, p) <- createProcess env
+    res <- try $ waitForProcess p
+    case res of
+        Left e -> error $ "waitForProcess threw: " ++ show (e :: SomeException)
+        Right ExitSuccess -> return ()
+        Right exitCode -> error $ "unexpected exit code: " ++ show exitCode
+
 withCurrentDirectory :: FilePath -> IO a -> IO a
 withCurrentDirectory new inner = do
   orig <- getCurrentDirectory