diff --git a/NEWS b/NEWS index ce748db12..afa412a44 100644 --- 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 5abc07a70..d4401f1a1 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2008-02-01 Neil Jerram + + * 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 * COPYING: Removed. diff --git a/libguile/modules.c b/libguile/modules.c index 10f72da3c..979131137 100644 --- 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 e7eff1511..49e29bf71 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,9 @@ +2008-02-01 Neil Jerram + + * standalone/Makefile.am: Add stanza for test-with-guile-module. + + * standalone/test-with-guile-module.c: New test. + 2008-01-22 Neil Jerram * COPYING: Removed. diff --git a/test-suite/standalone/.cvsignore b/test-suite/standalone/.cvsignore index 49fe7fee0..4b495e986 100644 --- 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 cd4e6743e..7160a16f4 100644 --- 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 index 000000000..e7abc81f8 --- /dev/null +++ b/test-suite/standalone/test-with-guile-module.c @@ -0,0 +1,52 @@ +#include +#include + +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; +}