Index: libguile/modules.c =================================================================== RCS file: /cvsroot/guile/guile/guile-core/libguile/modules.c,v retrieving revision 1.62.2.1 diff -u -r1.62.2.1 modules.c --- libguile/modules.c 12 Feb 2006 13:42:51 -0000 1.62.2.1 +++ libguile/modules.c 30 Jan 2008 23:39:10 -0000 @@ -40,12 +40,25 @@ 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_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) { Index: test-suite/standalone/Makefile.am =================================================================== RCS file: /cvsroot/guile/guile/guile-core/test-suite/standalone/Makefile.am,v retrieving revision 1.13.2.6 diff -u -r1.13.2.6 Makefile.am --- test-suite/standalone/Makefile.am 29 Dec 2007 01:34:18 -0000 1.13.2.6 +++ test-suite/standalone/Makefile.am 30 Jan 2008 23:39:10 -0000 @@ -110,6 +110,12 @@ 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} Index: test-suite/standalone/test-with-guile-module.c =================================================================== RCS file: test-suite/standalone/test-with-guile-module.c diff -N test-suite/standalone/test-with-guile-module.c --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ test-suite/standalone/test-with-guile-module.c 30 Jan 2008 23:39:10 -0000 @@ -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; +}