[perl-Glib] Make the thread-safety improvements work for non-threaded perls too

[Torsten SchÃnfeld <tsch src gnome org>]

commit 05c71e4abbee96e702a1885e91ed92dd8b3f6245
Author: Torsten SchÃnfeld <kaffeetisch gmx de>
Date:   Sun Feb 26 17:28:40 2012 +0100

    Make the thread-safety improvements work for non-threaded perls too

 GClosure.xs     |   10 +++++++++-
 Glib.xs         |   22 ++++++++++++++++++++++
 NEWS            |    5 +++++
 gperl-private.h |    5 +++++
 4 files changed, 41 insertions(+), 1 deletions(-)
---
diff --git a/GClosure.xs b/GClosure.xs
index 883902d..56d10ae 100644
--- a/GClosure.xs
+++ b/GClosure.xs
@@ -38,6 +38,7 @@ GPerlCallback, below.
 #include <gobject/gvaluecollector.h>
 
 #include "gperl_marshal.h"
+#include "gperl-private.h"
 
 
 static void
@@ -61,6 +62,13 @@ gperl_closure_invalidate (gpointer data,
 	}
 }
 
+#ifdef PERL_IMPLICIT_CONTEXT
+# define INVOKED_FROM_FOREIGN_THREAD (!PERL_GET_CONTEXT)
+#else
+# define INVOKED_FROM_FOREIGN_THREAD \
+	(_gperl_get_main_tid () != g_thread_self ())
+#endif
+
 static void _closure_hand_to_main (GClosure * closure,
                                    GValue * return_value,
                                    guint n_param_values,
@@ -89,7 +97,7 @@ gperl_closure_marshal (GClosure * closure,
 	 * Perl interpreter is not thread-safe.  For the same reason, we cannot
 	 * use perl_clone to create a new Perl interpreter from the main one.
 	 */
-	if (!PERL_GET_CONTEXT) {
+	if (INVOKED_FROM_FOREIGN_THREAD) {
 		g_printerr ("*** GPerl asked to invoke callback from a foreign thread; "
 		            "handing it over to the main loop\n");
 		_closure_hand_to_main (closure, return_value,
diff --git a/Glib.xs b/Glib.xs
index 81d9205..90eaa14 100644
--- a/Glib.xs
+++ b/Glib.xs
@@ -375,6 +375,25 @@ _gperl_get_master_interp (void)
 	return gperl_master_interp;
 }
 
+#ifndef PERL_IMPLICIT_CONTEXT
+/* If perl doesn't use thread-local storage, then we store the main thread's ID
+ * at BOOT time so that GClosure.xs can later find out whether we've been
+ * called from a foreign thread. */
+static GThread *gperl_main_tid = NULL;
+
+static void
+_gperl_fetch_main_tid (void)
+{
+	gperl_main_tid = g_thread_self ();
+}
+
+GThread *
+_gperl_get_main_tid (void)
+{
+	return gperl_main_tid;
+}
+#endif
+
 MODULE = Glib		PACKAGE = Glib		PREFIX = g_
 
 BOOT:
@@ -385,6 +404,9 @@ BOOT:
 #endif
 	g_type_init ();
 	_gperl_set_master_interp (PERL_GET_INTERP);
+#ifndef PERL_IMPLICIT_CONTEXT
+	_gperl_fetch_main_tid ();
+#endif
 	/* boot all in one go.  other modules may not want to do it this
 	 * way, if they prefer instead to perform demand loading. */
 	GPERL_CALL_BOOT (boot_Glib__Utils);
diff --git a/NEWS b/NEWS
index 3853177..1f5f717 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,8 @@
+Overview of changes in Glib <next>
+=================================
+
+* Make the recent thread-safety improvements work for non-threaded perls too.
+
 Overview of changes in Glib 1.251
 =================================
 
diff --git a/gperl-private.h b/gperl-private.h
index 684f0a1..ed91243 100644
--- a/gperl-private.h
+++ b/gperl-private.h
@@ -27,6 +27,11 @@ PerlInterpreter *_gperl_get_master_interp (void);
 		}			 				\
 	}
 
+
+#ifndef PERL_IMPLICIT_CONTEXT
+GThread * _gperl_get_main_tid (void);
+#endif
+
 /*
  * Misc. stuff
  */