~ chicken-core (chicken-5) 2477220de9c5663417f1d2626b34a3f71fc68992

commit 2477220de9c5663417f1d2626b34a3f71fc68992
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Fri Nov 22 20:34:30 2013 +0100
Commit:     Christian Kellermann <ckeen@pestilenz.org>
CommitDate: Wed Dec 11 11:01:35 2013 +0100

    Fix "process" under Windows and fix general error handling under Windows.
    
    - In PROCESS, don't try to mark duplicated descriptors from the parent
        process as inheritable; this isn't allowed (and they should already
        be inheritable or you can't duplicate them, and we duplicate with
        SAME_ACCESS anyway).
    - In PROCESS[*], don't try to close handles that haven't been opened.
    - When setting the errno for nonexisting error, don't loop endlessly.
    - When no error is known, just set it to ENOTSUP (what to do?)
    - Add simple regression test for process/process*.
    
    Signed-off-by: Christian Kellermann <ckeen@pestilenz.org>

diff --git a/NEWS b/NEWS
index 56987d05..36b53aec 100644
--- a/NEWS
+++ b/NEWS
@@ -13,10 +13,12 @@
      use modules and forgot to require ports but use procedures from it.
   - Support has been added for the space-safe R7RS macro "delay-force".
   - Export file-type from the posix unit (thanks to Alan Post).
-  - unsetenv has been fixed on Windows.
   - SRFI-4 s8vectors now work correctly in compiled code on PowerPC and ARM.
   - thread-join! now works correctly even if the waiting thread was
      prematurely woken up by a signal.
+  - unsetenv has been fixed on Windows.
+  - The process procedure has been fixed on Windows.
+  - The posix unit will no longer hang upon any error in Windows.
 
 - Platform support
   - CHICKEN can now be built on AIX (contributed by Erik Falor)
diff --git a/posixwin.scm b/posixwin.scm
index b8ae2da0..ede7e094 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -367,15 +367,16 @@ static errmap_t errmap[] =
 static void C_fcall
 set_errno(DWORD w32err)
 {
-    errmap_t *map = errmap;
-    for (; errmap->win32; ++map)
+    errmap_t *map;
+    for (map = errmap; map->win32; ++map)
     {
-	if (errmap->win32 == w32err)
+	if (map->win32 == w32err)
 	{
-	    errno = errmap->libc;
+	    errno = map->libc;
 	    return;
 	}
     }
+    errno = ENOSYS; /* For lack of anything better */
 }
 
 static int C_fcall
@@ -783,15 +784,13 @@ C_process(const char * app, const char * cmdlin, const char ** env,
 		if (modes[i]=='r') { child_io_handles[i]=a; parent_end=b; }
 		else		   { parent_end=a; child_io_handles[i]=b; }
 		success = (io_fds[i] = _open_osfhandle((C_word)parent_end,0)) >= 0;
+                /* Make new handle inheritable */
+		if (success)
+		  success = SetHandleInformation(child_io_handles[i], HANDLE_FLAG_INHERIT, -1);
 	    }
 	}
     }
 
-    /****** make handles inheritable */
-
-    for (i=0; i<3 && success; ++i)
-	success = SetHandleInformation(child_io_handles[i], HANDLE_FLAG_INHERIT, -1);
-
 #if 0 /* Requires a sorted list by key! */
     /****** create environment block if necessary ****/
 
@@ -851,7 +850,10 @@ C_process(const char * app, const char * cmdlin, const char ** env,
     /****** cleanup & return *********/
 
     /* parent must close child end */
-    for (i=0; i<3; ++i) CloseHandle(child_io_handles[i]);
+    for (i=0; i<3; ++i) {
+	if (child_io_handles[i] != NULL)
+	    CloseHandle(child_io_handles[i]);
+    }
 
     if (success)
     {
@@ -862,7 +864,10 @@ C_process(const char * app, const char * cmdlin, const char ** env,
     }
     else
     {
-	for (i=0; i<3; ++i) _close(io_fds[i]);
+	for (i=0; i<3; ++i) {
+	    if (io_fds[i] != -1)
+		_close(io_fds[i]);
+	}
     }
 
     return success;
diff --git a/tests/posix-tests.scm b/tests/posix-tests.scm
index f2273974..4459e36e 100644
--- a/tests/posix-tests.scm
+++ b/tests/posix-tests.scm
@@ -32,6 +32,17 @@
 (assert-error (process-execute "false" '("1" "123\x00456")))
 (assert-error (process-execute "false" '("123\x00456") '("foo\x00bar" "blabla") '("lalala" "qux\x00mooh")))
 
+(receive (in out pid)
+    (process "../csi" '("-n" "-e"
+                        "(write 'err (current-error-port)) (write 'ok)"))
+  (assert (equal? 'ok (read in))))
+
+(receive (in out pid err)
+    (process* "../csi" '("-n" "-e"
+                         "(write 'err (current-error-port)) (write 'ok)"))
+  (assert (equal? 'ok (read in)))
+  (assert (equal? 'err (read err))))
+
 (let ((tnpfilpn (create-temporary-file)))
   (let ((tmpfilno (file-open tnpfilpn (+ open/rdwr open/creat)))
         (data "abcde")