From: Eli Zaretskii <eliz@gnu.org>
Date: Fri, 27 Mar 2020 12:43:20 +0000 (+0300)
Subject: Port the 'module/async-pipe' test to MS-Windows
X-Git-Tag: emacs-28.0.90~7710
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f98ee21c0e3d4e00569fdd9f2671fd8394ab8a65;p=emacs.git

Port the 'module/async-pipe' test to MS-Windows

These changes let the code compile and produce a valid DLL, but the
test hangs.  It looks like the hang is in Fdelete_process, when it
closes one of the descriptors of the pipe process.
In addition, this use of the pipe process cannot currently work
on MS-Windows, since make-pipe-process doesn't set up the reader
thread to read from the Emacs's side of the pipe, so the select
emulation doesn't know there's stuff to read from that pipe.
* test/data/emacs-module/mod-test.c [WINDOWSNT]: Include
windows.h.
(ALIGN_STACK) [!__x86_64__]: Define for 32-bit builds.
(sleep_for_half_second): New function.
(write_to_pipe): Declare return type differently for WINDOWSNT.
Call sleep_for_half_second.
(Fmod_test_async_pipe) [WINDOWSNT]: Use _beginthread as substitute
for pthread_create.
(invalid_finalizer): Replace non_ASCII character in a comment.

* test/src/emacs-module-tests.el (module/async-pipe): Skip on
MS-Windows, as the test fails and then hangs.
---

diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index 61733f1ef49..5e3112f4471 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -30,8 +30,18 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include <string.h>
 #include <time.h>
 
-#include <pthread.h>
-#include <unistd.h>
+#ifdef WINDOWSNT
+/* Cannot include <process.h> because of the local header by the same
+   name, sigh.  */
+uintptr_t _beginthread (void (__cdecl *)(void *), unsigned, void *);
+# if !defined __x86_64__
+#  define ALIGN_STACK __attribute__((force_align_arg_pointer))
+# endif
+# include <windows.h>	/* for Sleep */
+#else  /* !WINDOWSNT */
+# include <pthread.h>
+# include <unistd.h>
+#endif
 
 #ifdef HAVE_GMP
 #include <gmp.h>
@@ -302,7 +312,7 @@ Fmod_test_invalid_load (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
 }
 
 /* An invalid finalizer: Finalizers are run during garbage collection,
-   where Lisp code can’t be executed.  -module-assertions tests for
+   where Lisp code can't be executed.  -module-assertions tests for
    this case.  */
 
 static emacs_env *current_env;
@@ -542,20 +552,39 @@ Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs,
   return env->funcall (env, Flist, 2, list_args);
 }
 
+static void
+sleep_for_half_second (void)
+{
+  /* mingw.org's MinGW has nanosleep, but MinGW64 doesn't.  */
+#ifdef WINDOWSNT
+  Sleep (500);
+#else
+  const struct timespec sleep = {0, 500000000};
+  if (nanosleep (&sleep, NULL) != 0)
+    perror ("nanosleep");
+#endif
+}
+
+#ifdef WINDOWSNT
+static void ALIGN_STACK
+#else
 static void *
+#endif
 write_to_pipe (void *arg)
 {
   /* We sleep a bit to test that writing to a pipe is indeed possible
      if no environment is active. */
-  const struct timespec sleep = {0, 500000000};
-  if (nanosleep (&sleep, NULL) != 0)
-    perror ("nanosleep");
+  sleep_for_half_second ();
   FILE *stream = arg;
+  /* The string below should be identical to the one we compare with
+     in emacs-module-tests.el:module/async-pipe.  */
   if (fputs ("data from thread", stream) < 0)
     perror ("fputs");
   if (fclose (stream) != 0)
     perror ("close");
+#ifndef WINDOWSNT
   return NULL;
+#endif
 }
 
 static emacs_value
@@ -572,12 +601,17 @@ Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
       signal_errno (env, "fdopen");
       return NULL;
     }
+#ifdef WINDOWSNT
+  uintptr_t thd = _beginthread (write_to_pipe, 0, stream);
+  int error = (thd == (uintptr_t)-1L) ? errno : 0;
+#else  /* !WINDOWSNT */
   pthread_t thread;
   int error
     = pthread_create (&thread, NULL, write_to_pipe, stream);
+#endif
   if (error != 0)
     {
-      signal_system_error (env, error, "pthread_create");
+      signal_system_error (env, error, "thread create");
       if (fclose (stream) != 0)
         perror ("fclose");
       return NULL;
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 1f91795e1e6..6851b890451 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -426,6 +426,7 @@ See Bug#36226."
 
 (ert-deftest module/async-pipe ()
   "Check that writing data from another thread works."
+  (skip-unless (not (eq system-type 'windows-nt))) ; FIXME!
   (with-temp-buffer
     (let ((process (make-pipe-process :name "module/async-pipe"
                                       :buffer (current-buffer)
@@ -435,6 +436,8 @@ See Bug#36226."
           (progn
             (mod-test-async-pipe process)
             (should (accept-process-output process 1))
+            ;; The string below must be identical to what
+            ;; mod-test.c:write_to_pipe produces.
             (should (equal (buffer-string) "data from thread")))
         (delete-process process)))))