Merge remote-tracking branch 'savannah/master' into HEAD

3 files changed, 108 insertions, 4 deletions

diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index ec6948921f2..5e3112f4471 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -30,6 +30,19 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include <string.h>
 #include <time.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>
 #else
@@ -299,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;
@@ -320,9 +333,9 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
 }
 
 static void
-signal_errno (emacs_env *env, const char *function)
+signal_system_error (emacs_env *env, int error, const char *function)
 {
-  const char *message = strerror (errno);
+  const char *message = strerror (error);
   emacs_value message_value = env->make_string (env, message, strlen (message));
   emacs_value symbol = env->intern (env, "file-error");
   emacs_value elements[2]
@@ -331,6 +344,12 @@ signal_errno (emacs_env *env, const char *function)
   env->non_local_exit_signal (env, symbol, data);
 }
 
+static void
+signal_errno (emacs_env *env, const char *function)
+{
+  signal_system_error (env, errno, function);
+}
+
 /* A long-running operation that occasionally calls `should_quit' or
    `process_input'.  */
 
@@ -533,6 +552,73 @@ 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. */
+  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
+Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+                      void *data)
+{
+  assert (nargs == 1);
+  int fd = env->open_channel (env, args[0]);
+  if (env->non_local_exit_check (env) != emacs_funcall_exit_return)
+    return NULL;
+  FILE *stream = fdopen (fd, "w");
+  if (stream == NULL)
+    {
+      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, "thread create");
+      if (fclose (stream) != 0)
+        perror ("fclose");
+      return NULL;
+    }
+  return env->intern (env, "nil");
+}
+
 /* Lisp utilities for easier readability (simple wrappers).  */
 
 /* Provide FEATURE to Emacs.  */
@@ -614,6 +700,7 @@ emacs_module_init (struct emacs_runtime *ert)
          Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL);
   DEFUN ("mod-test-function-finalizer-calls",
          Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL);
+  DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL);
 
 #undef DEFUN
 
diff --git a/test/lisp/image/gravatar-tests.el b/test/lisp/image/gravatar-tests.el
index e66b5c6803d..66098fa0116 100644
--- a/test/lisp/image/gravatar-tests.el
+++ b/test/lisp/image/gravatar-tests.el
@@ -67,6 +67,6 @@
         (gravatar-force-default nil)
         (gravatar-size nil))
     (should (equal (gravatar-build-url "foo") "\
-https://www.gravatar.com/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g"))))
+https://seccdn.libravatar.org/avatar/acbd18db4cc2f85cedef654fccc4a4d8?r=g"))))
 
 ;;; gravatar-tests.el ends here
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 48d2e86a605..6851b890451 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -424,4 +424,21 @@ See Bug#36226."
       ;; but at least one.
       (should (> valid-after valid-before)))))
 
+(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)
+                                      :coding 'utf-8-unix
+                                      :noquery t)))
+      (unwind-protect
+          (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)))))
+
 ;;; emacs-module-tests.el ends here