* 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.

diff --git a/NEWS b/NEWS
index ce748db12728569606f0ae42e120ebdd07bbdfc5..afa412a4429ef863210bd7af2d116ed67dd855a3 100644 (file)
--- a/NEWS
+++ b/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)
 

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 5abc07a7084cdef81d822f323fde8929afedf6e7..d4401f1a1a12042aa0e45bbd54f5e7d84f1bfe1d 100644 (file)
--- a/libguile/ChangeLog
+++ b/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.

diff --git a/libguile/modules.c b/libguile/modules.c
index 10f72da3cc3cb2530d84a115c4767ffdb481596d..9791311379f66cc7000ba383896aacf0d09e695c 100644 (file)
--- a/libguile/modules.c
+++ b/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)
 {

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index e7eff1511980ef32024c0d9a957cee01f0af1605..49e29bf717bbb361792c97149b0b3c2f4bbe98e0 100644 (file)
--- a/test-suite/ChangeLog
+++ b/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.

diff --git a/test-suite/standalone/.cvsignore b/test-suite/standalone/.cvsignore
index 49fe7fee0cc020397d8ee3d086ab8f9903f568d1..4b495e986eb7c688c276d0a81832aa04878a363a 100644 (file)
--- a/test-suite/standalone/.cvsignore
+++ b/test-suite/standalone/.cvsignore
@@ -11,3 +11,4 @@ test-num2integral
 test-round
 test-unwind
 test-list
+test-with-guile-module

diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am
index cd4e6743e3001e00528a74d00cc665665d0b5b14..7160a16f45489f8c048ba3323b36821c75ef0275 100644 (file)
--- a/test-suite/standalone/Makefile.am
+++ b/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}
 

diff --git a/test-suite/standalone/test-with-guile-module.c b/test-suite/standalone/test-with-guile-module.c
new file mode 100644 (file)
index 0000000..e7abc81
--- /dev/null
+++ b/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;
+}