From 052155c6c3bf5dc7455a178cd8c0722d8f09a614 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <daniel@turtleware.eu>
Date: Mon, 22 May 2017 22:58:15 +0200
Subject: [PATCH] ecl_thread_internal_error: add C api, protect get_env

Problem reported and fixed by Marius Gerbershagen. Fixes #382.
---
 src/c/error.d           | 14 ++++++++++++++
 src/c/threads/process.d |  7 ++++---
 src/h/external.h        |  3 +++
 3 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/src/c/error.d b/src/c/error.d
index 8db46eb3b..337dffcc3 100644
--- a/src/c/error.d
+++ b/src/c/error.d
@@ -61,6 +61,20 @@ ecl_internal_error(const char *s)
   abort();
 }
 
+#ifdef ECL_THREADS
+void
+ecl_thread_internal_error(const char *s)
+{
+  int saved_errno = errno;
+  fprintf(stderr, "\nInternal thread error in:\n%s\n", s);
+  if (saved_errno) {
+    fprintf(stderr, "  [%d: %s]\n", saved_errno,
+            strerror(saved_errno));
+  }
+  fflush(stderr);
+  pthread_exit(NULL);
+}
+#endif
 
 void
 ecl_unrecoverable_error(cl_env_ptr the_env, const char *message)
diff --git a/src/c/threads/process.d b/src/c/threads/process.d
index 645b3af72..ca77c83bd 100755
--- a/src/c/threads/process.d
+++ b/src/c/threads/process.d
@@ -52,7 +52,7 @@ ecl_process_env(void)
   struct cl_env_struct *rv = pthread_getspecific(cl_env_key);
   if (rv)
     return rv;
-  FElibc_error("pthread_getspecific() failed.", 0);
+  ecl_thread_internal_error("pthread_getspecific() failed.");
   return NULL;
 #endif
 }
@@ -67,8 +67,9 @@ ecl_set_process_env(cl_env_ptr env)
 # ifdef ECL_WINDOWS_THREADS
   TlsSetValue(cl_env_key, env);
 # else
-  if (pthread_setspecific(cl_env_key, env))
-    FElibc_error("pthread_setspecific() failed.", 0);
+  if (pthread_setspecific(cl_env_key, env)) {
+    ecl_thread_internal_error("pthread_setspecific() failed.");
+  }
 # endif
 #endif
 }
diff --git a/src/h/external.h b/src/h/external.h
index 68a58394a..20fe5dcbc 100755
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -553,6 +553,9 @@ extern ECL_API cl_object cl_error _ECL_ARGS((cl_narg narg, cl_object eformat, ..
 extern ECL_API cl_object cl_cerror _ECL_ARGS((cl_narg narg, cl_object cformat, cl_object eformat, ...));
 
 extern ECL_API void ecl_internal_error(const char *s) ecl_attr_noreturn;
+#ifdef ECL_THREADS
+extern ECL_API void ecl_thread_internal_error(const char *s) ecl_attr_noreturn;
+#endif
 extern ECL_API void ecl_unrecoverable_error(cl_env_ptr the_env, const char *message) ecl_attr_noreturn;
 extern ECL_API void ecl_cs_overflow(void) /*ecl_attr_noreturn*/;
 extern ECL_API void FEprogram_error(const char *s, int narg, ...) ecl_attr_noreturn;