improve error message for out-of-date module accesses

svn: r10990
This commit is contained in:
Matthew Flatt 2008-07-30 20:47:19 +00:00
parent 16b04d0328
commit f46c257a42
4 changed files with 30 additions and 10 deletions

View File

@ -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;

View File

@ -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;

View File

@ -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;
}

View File

@ -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,