* modules.c (the_root_module): Moved before scm_current_module.

(scm_current_module): Return the root module if `the-module' fluid
gives #f.

* standalone/Makefile.am: Add stanza for test-with-guile-module.

* standalone/test-with-guile-module.c: New test.

NEWS

@@ -17,6 +17,7 @@ backtrace of a stack with a promise object (made by `delay') in it.
 ** Fixed a build problem on AIX (use of func_data identifier)
 ** Fixed a segmentation fault which occurred when hashx-ref or hashx-set! was
 called with an associator proc that returns neither a pair nor #f.
+** Secondary threads now always return a valid module for (current-module).
 
 * New modules (see the manual for details)
 

libguile/ChangeLog

@@ -1,3 +1,9 @@
+2008-02-01  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* modules.c (the_root_module): Moved before scm_current_module.
+	(scm_current_module): Return the root module if `the-module' fluid
+	gives #f.
+
 2008-01-22  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* COPYING: Removed.

libguile/modules.c

@@ -40,12 +40,25 @@ scm_t_bits scm_module_tag;
 
 static SCM the_module;
 
+static SCM the_root_module_var;
+
+static SCM
+the_root_module ()
+{
+  if (scm_module_system_booted_p)
+    return SCM_VARIABLE_REF (the_root_module_var);
+  else
+    return SCM_BOOL_F;
+}
+
 SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
 	    (),
 	    "Return the current module.")
 #define FUNC_NAME s_scm_current_module
 {
-  return scm_fluid_ref (the_module);
+  SCM curr = scm_fluid_ref (the_module);
+
+  return scm_is_true (curr) ? curr : the_root_module ();
 }
 #undef FUNC_NAME
 
@@ -234,17 +247,6 @@ scm_env_top_level (SCM env)
 
 SCM_SYMBOL (sym_module, "module");
 
-static SCM the_root_module_var;
-
-static SCM
-the_root_module ()
-{
-  if (scm_module_system_booted_p)
-    return SCM_VARIABLE_REF (the_root_module_var);
-  else
-    return SCM_BOOL_F;
-}
-
 SCM
 scm_lookup_closure_module (SCM proc)
 {

test-suite/ChangeLog

@@ -1,3 +1,9 @@
+2008-02-01  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* standalone/Makefile.am: Add stanza for test-with-guile-module.
+
+	* standalone/test-with-guile-module.c: New test.
+
 2008-01-22  Neil Jerram  <neil@ossau.uklinux.net>
 
 	* COPYING: Removed.

test-suite/standalone/.cvsignore

@@ -11,3 +11,4 @@ test-num2integral
 test-round
 test-unwind
 test-list
+test-with-guile-module

test-suite/standalone/Makefile.am

@@ -110,6 +110,12 @@ TESTS += test-conversion
 check_SCRIPTS += test-use-srfi
 TESTS += test-use-srfi
 
+# test-with-guile-module
+test_with_guile_module_CFLAGS = ${test_cflags}
+test_with_guile_module_LDADD = ${top_builddir}/libguile/libguile.la
+check_PROGRAMS += test-with-guile-module
+TESTS += test-with-guile-module
+
 all-local:
 	cd ${srcdir} && chmod u+x ${check_SCRIPTS}
 

test-suite/standalone/test-with-guile-module.c

@@ -0,0 +1,52 @@
+#include <pthread.h>
+#include <libguile.h>
+
+void * thread_inner_main (void * unused);
+void * thread_main (void * unused);
+void * do_join (void * data);
+void * inner_main (void * unused);
+
+void * thread_inner_main (void * unused)
+{
+  int argc = 3;
+  char* argv[] = { "guile",
+		   "-c",
+		   "(or (current-module) (exit -1))",
+		   0 };
+  scm_shell (argc, argv);
+
+  return NULL; /* dummy */
+}
+
+void * thread_main (void * unused)
+{
+  scm_with_guile (&thread_inner_main, NULL);
+
+  return NULL; /* dummy */
+}
+
+void * do_join (void * data)
+{
+  pthread_t *thread = (pthread_t *)data;
+
+  pthread_join (*thread, NULL);
+
+  return NULL; /* dummy */
+}
+
+void * inner_main (void * unused)
+{
+  pthread_t thread;
+
+  pthread_create (&thread, NULL, &thread_main, NULL);
+  scm_without_guile (do_join, &thread);
+
+  return NULL; /* dummy */
+}
+
+int main (int argc, char **argv)
+{
+  scm_with_guile (&inner_main, NULL);
+
+  return 0;
+}