suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix broken abort handling related to module-registry lock

Browse Source
This commit is contained in:
Matthew Flatt 2015-11-15 16:46:07 -07:00
parent 0e16ce4bea
commit d3f2bd6dac
2 changed files with 39 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
pkgs/racket-test-core/tests/racket/module.rktl
View File

@ -1642,6 +1642,34 @@ case of module-leve bindings; it doesn't cover local bindings.
(#%require (submod ".." ma)) (#%require (submod ".." ma))
(foo))))) (foo)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure that shutting down a custodian
;; releases a lock as it should
(parameterize ([current-custodian (make-custodian)])
(thread-wait
(thread
(lambda ()
(parameterize ([current-namespace (make-base-namespace)])
(eval '(module m racket/base
(require (for-syntax racket/base))
(begin-for-syntax
#;(log-error "nested")
;; Using an environment variable to communicate across phases:
(when (getenv "PLT_ready_to_end")
#;(log-error "adios")
(custodian-shutdown-all (current-custodian))))))
(eval '(module n racket/base
(require (for-syntax racket/base))
(begin-for-syntax
#;(log-error "outer")
(dynamic-require ''m 0)
(eval #f))))
(putenv "PLT_ready_to_end" "yes")
(dynamic-require ''n 0)
#;(log-error "go")
(eval #f))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)

17
racket/src/racket/src/module.c
View File

@ -4932,9 +4932,11 @@ static void lock_registry(Scheme_Env *env)
static void unlock_registry(Scheme_Env *env) static void unlock_registry(Scheme_Env *env)
{ {
Scheme_Object *lock; Scheme_Object *lock;
lock = scheme_hash_get(env->module_registry->loaded, scheme_false); if (env) {
scheme_post_sema(SCHEME_CAR(lock)); lock = scheme_hash_get(env->module_registry->loaded, scheme_false);
scheme_hash_set(env->module_registry->loaded, scheme_false, NULL); scheme_post_sema(SCHEME_CAR(lock));
scheme_hash_set(env->module_registry->loaded, scheme_false, NULL);
}
} }
XFORM_NONGCING static intptr_t make_key(int base_phase, int eval_exp, int eval_run) XFORM_NONGCING static intptr_t make_key(int base_phase, int eval_exp, int eval_run)
@ -5742,7 +5744,7 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
static void do_prepare_compile_env(Scheme_Env *env, int base_phase, int pos) static void do_prepare_compile_env(Scheme_Env *env, int base_phase, int pos)
{ {
Scheme_Object *v, *prev; Scheme_Object *v, *prev;
Scheme_Env *menv; Scheme_Env *menv, *uenv;
int need_lock; int need_lock;
need_lock = wait_registry(env); need_lock = wait_registry(env);
@ -5763,14 +5765,17 @@ static void do_prepare_compile_env(Scheme_Env *env, int base_phase, int pos)
} }
v = prev; v = prev;
if (need_lock) if (need_lock) {
lock_registry(env); lock_registry(env);
uenv = env;
} else
uenv = NULL;
while (SCHEME_NAMESPACEP(v)) { while (SCHEME_NAMESPACEP(v)) {
menv = (Scheme_Env *)v; menv = (Scheme_Env *)v;
v = menv->available_next[pos]; v = menv->available_next[pos];
menv->available_next[pos] = NULL; menv->available_next[pos] = NULL;
BEGIN_ESCAPEABLE(unlock_registry, env); BEGIN_ESCAPEABLE(unlock_registry, uenv);
start_module(menv->module, menv->instance_env, 0, start_module(menv->module, menv->instance_env, 0,
NULL, 1, 0, base_phase, NULL, 1, 0, base_phase,
scheme_null, 1); scheme_null, 1);