diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index a4a57d461a..c64b5e5976 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -2654,7 +2654,8 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, if (val && !(flags & SCHEME_NO_CERT_CHECKS)) scheme_check_accessible_in_module(genv, env->insp, in_modidx, find_id, src_find_id, certs, NULL, -2, 0, - NULL); + NULL, + env->genv); } else { /* Only try syntax table if there's not an explicit (later) variable mapping: */ @@ -2678,7 +2679,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, else pos = scheme_check_accessible_in_module(genv, env->insp, in_modidx, find_id, src_find_id, certs, NULL, -1, 1, - _protected); + _protected, env->genv); modpos = SCHEME_INT_VAL(pos); } else modpos = -1; diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index a4a7aa0fa6..ce20ac47c3 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -1835,7 +1835,8 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx, } if (!SAME_OBJ(menv, env)) { - varname = scheme_check_accessible_in_module(menv, insp, NULL, varname, NULL, NULL, insp, pos, 0, NULL); + varname = scheme_check_accessible_in_module(menv, insp, NULL, varname, NULL, NULL, + insp, pos, 0, NULL, env); } } @@ -5551,7 +5552,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env, SCHEME_EXPAND_OBSERVE_EXIT_PRIM(rec[drec].observer, form); SCHEME_EXPAND_OBSERVE_RETURN(rec[drec].observer, form); return form; - } else if (rec[drec].comp && SAME_OBJ(var, normal)) { + } else if (rec[drec].comp && SAME_OBJ(var, normal) && !rec[drec].observer) { /* Skip creation of intermediate form */ Scheme_Syntax *f; taking_shortcut = 1; diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index 0c294cd5c9..548a525fbf 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -3229,7 +3229,8 @@ static void check_certified(Scheme_Object *stx, Scheme_Object *certs, Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object *prot_insp, Scheme_Object *in_modidx, Scheme_Object *symbol, Scheme_Object *stx, Scheme_Object *certs, Scheme_Object *unexp_insp, - int position, int want_pos, int *_protected) + int position, int want_pos, int *_protected, + Scheme_Env *from_env) /* Returns the actual name when !want_pos, needed in case of uninterned names. Otherwise, returns a position value on success. If position < -1, then merely checks for protected syntax. @@ -3354,10 +3355,27 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object symbol = stx; stx = NULL; } - scheme_wrong_syntax("compile", stx, symbol, - "variable not provided (directly or indirectly%s) from module: %D", - (position >= 0) ? " and at the expected position" : "", - env->module->modname); + + { + const char *srcstr; + long srclen; + + if (from_env->module) + srcstr = scheme_display_to_string(from_env->module->modname, &srclen); + else { + srcstr = ""; + srclen = 0; + } + + scheme_wrong_syntax("link", stx, symbol, + "module mismatch, probably from old bytecode whose dependencies have changed: " + "variable not provided (directly or indirectly%s) from module: %D %s%t", + (position >= 0) ? " and at the expected position" : "", + env->module->modname, + srclen ? "accessed from module: " : "", + srcstr, srclen); + } + return NULL; } diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index 058c74b31c..ff119363c9 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -2592,7 +2592,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object Scheme_Object *symbol, Scheme_Object *stx, Scheme_Object *certs, Scheme_Object *unexp_insp, int position, int want_pos, - int *_protected); + int *_protected, Scheme_Env *from_env); Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name); Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,