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

fix run-time error reporting for variables in a submodule

Browse Source 
Error reports used the "source" field of a module, which
doesn't have submodule information, or the "name" field of
a module, which might not match an actual filename (".ss"
vs. ".rkt"). Create the right combination.
This commit is contained in:
Matthew Flatt 2014-08-11 07:36:56 +01:00
parent e569710e63
commit 5ef75682d7
4 changed files with 40 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
racket/src/racket/src/error.c
View File

@ -2597,7 +2597,7 @@ void scheme_unbound_global(Scheme_Bucket *b)
name, name,
errmsg, errmsg,
name, name,
home->module->modsrc, scheme_get_modsrc(home->module),
phase, phase,
phase_note); phase_note);
} else { } else {

14
racket/src/racket/src/eval.c
View File

@ -848,6 +848,10 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx,
menv = scheme_module_access(modname, env, mod_phase); menv = scheme_module_access(modname, env, mod_phase);
if (!menv) { if (!menv) {
Scheme_Object *modsrc;
modsrc = (env->module
? scheme_get_modsrc(env->module)
: scheme_false);
scheme_wrong_syntax("link", NULL, varname, scheme_wrong_syntax("link", NULL, varname,
"namespace mismatch;\n" "namespace mismatch;\n"
" reference to a module that is not available\n" " reference to a module that is not available\n"
@ -858,7 +862,7 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx,
env->phase, env->phase,
modname, modname,
mod_phase, mod_phase,
env->module ? env->module->modsrc : scheme_false); modsrc);
return NULL; return NULL;
} }
@ -911,6 +915,10 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx,
} }
if (bad_reason) { if (bad_reason) {
Scheme_Object *modsrc;
modsrc = (env->module
? scheme_get_modsrc(env->module)
: scheme_false);
scheme_wrong_syntax("link", NULL, varname, scheme_wrong_syntax("link", NULL, varname,
"bad variable linkage;\n" "bad variable linkage;\n"
" reference to a variable that %s\n" " reference to a variable that %s\n"
@ -922,7 +930,7 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx,
env->phase, env->phase,
modname, modname,
mod_phase, mod_phase,
env->module ? env->module->modsrc : scheme_false); modsrc);
} }
if (!(((Scheme_Bucket_With_Flags *)bkt)->flags & (GLOB_IS_IMMUTATED | GLOB_IS_LINKED))) if (!(((Scheme_Bucket_With_Flags *)bkt)->flags & (GLOB_IS_IMMUTATED | GLOB_IS_LINKED)))
@ -1892,7 +1900,7 @@ void scheme_set_global_bucket(char *who, Scheme_Bucket *b, Scheme_Object *val,
: "constant") : "constant")
: "variable"), : "variable"),
(Scheme_Object *)b->key, (Scheme_Object *)b->key,
home->module->modsrc); scheme_get_modsrc(home->module));
} else { } else {
scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, b->key, scheme_raise_exn(MZEXN_FAIL_CONTRACT_VARIABLE, b->key,
"%s: " CANNOT_SET_ERROR_STR ";\n" "%s: " CANNOT_SET_ERROR_STR ";\n"

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

@ -169,9 +169,6 @@ static int phaseless_rhs(Scheme_Object *val, int var_count, int phase);
#define cons scheme_make_pair #define cons scheme_make_pair
/* We'd prefer a field like modsrc, but with submodule info like modname: */
#define MODSRCNAME modname
/* global read-only kernel stuff */ /* global read-only kernel stuff */
READ_ONLY static Scheme_Object *kernel_modname; READ_ONLY static Scheme_Object *kernel_modname;
READ_ONLY static Scheme_Object *kernel_symbol; READ_ONLY static Scheme_Object *kernel_symbol;
@ -1302,7 +1299,7 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
scheme_contract_error(errname, scheme_contract_error(errname,
"name is provided as syntax", "name is provided as syntax",
"name", 1, name, "name", 1, name,
"module", 1, srcm->MODSRCNAME, "module", 1, scheme_get_modsrc(srcm),
NULL); NULL);
} }
} }
@ -1363,7 +1360,7 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
scheme_contract_error(errname, scheme_contract_error(errname,
"name is not provided", "name is not provided",
"name", 1, name, "name", 1, name,
"module", 1, srcm->MODSRCNAME, "module", 1, scheme_get_modsrc(srcm),
NULL); NULL);
} }
return NULL; return NULL;
@ -1419,14 +1416,14 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[],
scheme_contract_error(errname, scheme_contract_error(errname,
"name is protected", "name is protected",
"name", 1, name, "name", 1, name,
"module", 1, srcm->MODSRCNAME, "module", 1, scheme_get_modsrc(srcm),
NULL); NULL);
} }
if (!menv || !menv->toplevel) { if (!menv || !menv->toplevel) {
scheme_contract_error(errname, scheme_contract_error(errname,
"module inialization failed", "module inialization failed",
"module", 1, srcm->MODSRCNAME, "module", 1, scheme_get_modsrc(srcm),
NULL); NULL);
} }
@ -4487,7 +4484,7 @@ static void check_certified(Scheme_Object *stx,
"access disallowed by code inspector to %s %s from module: %D", "access disallowed by code inspector to %s %s from module: %D",
prot ? "protected" : "unexported", prot ? "protected" : "unexported",
var ? "variable" : "syntax", var ? "variable" : "syntax",
env->module->MODSRCNAME); scheme_get_modsrc(env->module));
} }
} }
} }
@ -4706,7 +4703,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
intptr_t srclen; intptr_t srclen;
if (from_env->module) if (from_env->module)
srcstr = scheme_display_to_string(from_env->module->MODSRCNAME, &srclen); srcstr = scheme_display_to_string(scheme_get_modsrc(from_env->module), &srclen);
else { else {
srcstr = ""; srcstr = "";
srclen = 0; srclen = 0;
@ -4722,7 +4719,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
srclen ? " importing module: " : "", srclen ? " importing module: " : "",
srcstr, srclen, srcstr, srclen,
srclen ? "\n" : "", srclen ? "\n" : "",
env->module->MODSRCNAME, scheme_get_modsrc(env->module),
env->mod_phase, env->mod_phase,
(position >= 0) ? " and at the expected position" : ""); (position >= 0) ? " and at the expected position" : "");
} }
@ -4836,7 +4833,7 @@ Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env,
" but need (dynamic-require .... 0)\n" " but need (dynamic-require .... 0)\n"
" module: %D\n" " module: %D\n"
" phase: %d", " phase: %d",
menv->module->MODSRCNAME, scheme_get_modsrc(menv->module),
mod_phase); mod_phase);
return NULL; return NULL;
} }
@ -5611,7 +5608,7 @@ static void start_module(Scheme_Module *m, Scheme_Env *env, int restart,
if (SAME_OBJ(m->modname, SCHEME_CAR(l))) { if (SAME_OBJ(m->modname, SCHEME_CAR(l))) {
scheme_contract_error("module", scheme_contract_error("module",
"import cycle detected", "import cycle detected",
"module in cycle", 1, m->MODSRCNAME, "module in cycle", 1, scheme_get_modsrc(m),
NULL); NULL);
} }
} }
@ -5781,7 +5778,7 @@ static void eval_module_body(Scheme_Env *menv, Scheme_Env *env)
} }
#ifdef MZ_USE_JIT #ifdef MZ_USE_JIT
(void)scheme_module_run_start(menv, env, scheme_make_pair(menv->module->MODSRCNAME, scheme_true)); (void)scheme_module_run_start(menv, env, scheme_make_pair(scheme_get_modsrc(menv->module), scheme_true));
#else #else
(void)scheme_module_run_finish(menv, env); (void)scheme_module_run_finish(menv, env);
#endif #endif
@ -6665,6 +6662,22 @@ Scheme_Object *scheme_module_execute(Scheme_Object *data, Scheme_Env *genv)
return do_module_execute(data, genv, 1, 0, NULL, NULL); return do_module_execute(data, genv, 1, 0, NULL, NULL);
} }
Scheme_Object *scheme_get_modsrc(Scheme_Module *mod)
{
Scheme_Object *p, *p2;
p = scheme_resolved_module_path_value(mod->modname);
if (SCHEME_PAIRP(p)) {
/* Construct a submodule path based on `modsrc` instead of `modname`. */
p2 = scheme_resolved_module_path_value(mod->modsrc);
if (SAME_OBJ(SCHEME_CAR(p), p2))
return mod->modname;
else
return scheme_intern_resolved_module_path(scheme_make_pair(p2, SCHEME_CDR(p)));
} else
return mod->modsrc;
}
static Scheme_Object *rebuild_et_vec(Scheme_Object *naya, Scheme_Object *vec, Resolve_Prefix *rp) static Scheme_Object *rebuild_et_vec(Scheme_Object *naya, Scheme_Object *vec, Resolve_Prefix *rp)
{ {
Scheme_Object *vec2; Scheme_Object *vec2;

2
racket/src/racket/src/schpriv.h
View File

@ -3579,6 +3579,8 @@ char *scheme_submodule_path_to_string(Scheme_Object *p, intptr_t *_len);
Scheme_Object *scheme_annotate_existing_submodules(Scheme_Object *orig_fm, int incl_star); Scheme_Object *scheme_annotate_existing_submodules(Scheme_Object *orig_fm, int incl_star);
Scheme_Object *scheme_get_modsrc(Scheme_Module *m);
/*========================================================================*/ /*========================================================================*/
/* errors and exceptions */ /* errors and exceptions */
/*========================================================================*/ /*========================================================================*/