improve error for misuse of non-serializable module
When the original compiler handler is called with a true second argument, then the resulting module is not serializable. Improve detecting and reporting of the misuse. The error is phrase in terms of linklets, which is not ideal, but that's the level where the error can be detected. Abusing the original compile handler in this way is not easy, though, so maybe this improvement is enough.
This commit is contained in:
Matthew Flatt
parent
2643a75ce3
commit
db322a49ee
|
|
@ -3027,6 +3027,19 @@ case of module-leve bindings; it doesn't cover local bindings.
|
|||
(lambda (exn)
|
||||
(regexp-match? #rx"already required\n at: x\n in: \\(quote require-conflict-is-sourced-b\\)\n also provided by: \\(quote require-conflict-is-sourced-a\\)" (exn-message exn))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Make sure the error is reasonable if `current-compile`
|
||||
;; is used directly and the result abused:
|
||||
|
||||
(parameterize ([current-compile
|
||||
(let ([orig-compile (current-compile)])
|
||||
(lambda (stx im?)
|
||||
(orig-compile stx #t)))]) ; #t argument sets up the abuse
|
||||
(define c (compile '(module m racket/base)))
|
||||
(err/rt-test (write c (open-output-bytes))
|
||||
exn:fail:contract?
|
||||
#rx"write: linklet is not serializable"))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -20,6 +20,7 @@
|
|||
[(not i) (values ht cross-machine)]
|
||||
[else
|
||||
(let-values ([(key v) (hash-iterate-key+value orig-ht i)])
|
||||
(when (linklet? v) (check-fasl-preparation v))
|
||||
(let ([new-v (if (and (linklet? v)
|
||||
(pair? (linklet-paths v)))
|
||||
(adjust-cross-perparation
|
||||
|
|
@ -46,3 +47,8 @@
|
|||
(if (or (pair? p) (eq? p 'faslable-unsafe))
|
||||
(set-linklet-preparation l 'faslable)
|
||||
l)))
|
||||
|
||||
(define (check-fasl-preparation l)
|
||||
(case (linklet-preparation l)
|
||||
[(callable lazy)
|
||||
(raise-arguments-error 'write "linklet is not serializable")]))
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@ static Scheme_Linklet *compile_and_or_optimize_linklet(Scheme_Object *form, Sche
|
|||
Scheme_Object *name,
|
||||
Scheme_Object **_import_keys,
|
||||
Scheme_Object *get_import,
|
||||
int unsafe_mode, int static_mode);
|
||||
int unsafe_mode, int static_mode, int serializable);
|
||||
|
||||
static Scheme_Object *_instantiate_linklet_multi(Scheme_Linklet *linklet, Scheme_Instance *instance,
|
||||
int num_instances, Scheme_Instance **instances,
|
||||
|
|
@ -355,7 +355,8 @@ void extract_import_info(const char *who, int argc, Scheme_Object **argv,
|
|||
|
||||
static void parse_compile_options(const char *who, int arg_pos,
|
||||
int argc, Scheme_Object **argv,
|
||||
int *_unsafe, int *_static_mode)
|
||||
int *_unsafe, int *_static_mode,
|
||||
int *_serializable)
|
||||
{
|
||||
Scheme_Object *redundant = NULL, *flag, *flags = argv[arg_pos];
|
||||
int serializable = 0;
|
||||
|
|
@ -404,14 +405,13 @@ static void parse_compile_options(const char *who, int arg_pos,
|
|||
|
||||
*_unsafe = unsafe;
|
||||
*_static_mode = static_mode;
|
||||
*_serializable = serializable;
|
||||
}
|
||||
|
||||
static Scheme_Object *compile_linklet(int argc, Scheme_Object **argv)
|
||||
{
|
||||
Scheme_Object *name, *e, *import_keys, *get_import, *a[2];
|
||||
int unsafe = 0, static_mode = 0;
|
||||
|
||||
/* Last argument, `serializable?`, is ignored */
|
||||
int unsafe = 0, static_mode = 0, serializable = 1;
|
||||
|
||||
extract_import_info("compile-linklet", argc, argv, &import_keys, &get_import);
|
||||
|
||||
|
|
@ -432,10 +432,10 @@ static Scheme_Object *compile_linklet(int argc, Scheme_Object **argv)
|
|||
}
|
||||
|
||||
if (argc > 4)
|
||||
parse_compile_options("compile-linklet", 4, argc, argv, &unsafe, &static_mode);
|
||||
parse_compile_options("compile-linklet", 4, argc, argv, &unsafe, &static_mode, &serializable);
|
||||
|
||||
e = (Scheme_Object *)compile_and_or_optimize_linklet(e, NULL, name, &import_keys, get_import,
|
||||
unsafe, static_mode);
|
||||
unsafe, static_mode, serializable);
|
||||
|
||||
if (import_keys) {
|
||||
a[0] = e;
|
||||
|
|
@ -449,7 +449,7 @@ static Scheme_Object *recompile_linklet(int argc, Scheme_Object **argv)
|
|||
{
|
||||
Scheme_Object *name, *import_keys, *get_import, *a[2];
|
||||
Scheme_Linklet *linklet;
|
||||
int unsafe = 0, static_mode = 0;
|
||||
int unsafe = 0, static_mode = 0, serializable = 1;
|
||||
|
||||
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_linklet_type))
|
||||
scheme_wrong_contract("recompile-linklet", "linklet?", 0, argc, argv);
|
||||
|
|
@ -475,10 +475,10 @@ static Scheme_Object *recompile_linklet(int argc, Scheme_Object **argv)
|
|||
}
|
||||
|
||||
if (argc > 4)
|
||||
parse_compile_options("recompile-linklet", 4, argc, argv, &unsafe, &static_mode);
|
||||
parse_compile_options("recompile-linklet", 4, argc, argv, &unsafe, &static_mode, &serializable);
|
||||
|
||||
linklet = compile_and_or_optimize_linklet(NULL, linklet, name, &import_keys, get_import,
|
||||
unsafe, static_mode);
|
||||
unsafe, static_mode, serializable);
|
||||
|
||||
if (import_keys) {
|
||||
a[0] = (Scheme_Object *)linklet;
|
||||
|
|
@ -1136,7 +1136,7 @@ static Scheme_Hash_Tree *update_source_names(Scheme_Hash_Tree *source_names,
|
|||
static Scheme_Linklet *compile_and_or_optimize_linklet(Scheme_Object *form, Scheme_Linklet *linklet,
|
||||
Scheme_Object *name,
|
||||
Scheme_Object **_import_keys, Scheme_Object *get_import,
|
||||
int unsafe_mode, int static_mode)
|
||||
int unsafe_mode, int static_mode, int serializable)
|
||||
{
|
||||
Scheme_Config *config;
|
||||
int enforce_const, set_undef, can_inline;
|
||||
|
|
@ -1181,12 +1181,15 @@ static Scheme_Linklet *compile_and_or_optimize_linklet(Scheme_Object *form, Sche
|
|||
|
||||
scheme_performance_record_end("compile", &perf_state);
|
||||
|
||||
if (serializable)
|
||||
linklet->serializable = 1;
|
||||
|
||||
return linklet;
|
||||
}
|
||||
|
||||
Scheme_Linklet *scheme_compile_and_optimize_linklet(Scheme_Object *form, Scheme_Object *name)
|
||||
{
|
||||
return compile_and_or_optimize_linklet(form, NULL, name, NULL, NULL, 0, 1);
|
||||
return compile_and_or_optimize_linklet(form, NULL, name, NULL, NULL, 0, 1, 0);
|
||||
}
|
||||
|
||||
/*========================================================================*/
|
||||
|
|
|
|||
|
|
@ -292,8 +292,12 @@ Scheme_Object *scheme_write_linklet(Scheme_Object *obj)
|
|||
|
||||
if (linklet->jit_ready)
|
||||
scheme_arg_mismatch("write",
|
||||
"cannot marshal linklet that has been evaluated",
|
||||
"cannot marshal linklet that has been evaluated: ",
|
||||
obj);
|
||||
if (!linklet->serializable)
|
||||
scheme_contract_error("write",
|
||||
"linklet is not serializable",
|
||||
NULL);
|
||||
|
||||
l = scheme_null;
|
||||
|
||||
|
|
@ -405,6 +409,8 @@ Scheme_Object *scheme_read_linklet(Scheme_Object *obj, int unsafe_ok)
|
|||
linklet = MALLOC_ONE_TAGGED(Scheme_Linklet);
|
||||
linklet->so.type = scheme_linklet_type;
|
||||
|
||||
linklet->serializable = 1;
|
||||
|
||||
if (!SCHEME_PAIRP(obj)) return_NULL();
|
||||
linklet->name = SCHEME_CAR(obj);
|
||||
if (!SCHEME_SYMBOLP(linklet->name)) return_NULL();
|
||||
|
|
|
|||
|
|
@ -3318,6 +3318,7 @@ struct Scheme_Linklet
|
|||
|
||||
char jit_ready; /* true if the linklet is in has been prepared for the JIT */
|
||||
char reject_eval; /* true when loaded without the root inspector, for example */
|
||||
char serializable; /* record whether the linklet was intended to be serialized */
|
||||
|
||||
Scheme_Hash_Table *constants; /* holds info about the linklet's body for inlining */
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user