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

expander: fix submodule order nondeterminism

Browse Source 
The nondeterminstic order could lead to a mismatch that caused
Racket CS to crash on submodule tests.
This commit is contained in:
Matthew Flatt 2019-04-08 07:17:48 -06:00
parent 8dfc690eba
commit e6aef1093b
3 changed files with 148 additions and 124 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
racket/src/expander/compile/module.rkt
View File

@ -55,9 +55,9 @@
(not (parsed-module-compiled-module p)))
(update-submodule-names (cdr star?+compiled) name full-module-name)
(cdr star?+compiled)))))
(define pre-submodules (get-submodules #f))
(define post-submodules (get-submodules #t))
(define pre-submodules (sort (get-submodules #f) symbol<? #:key car))
(define post-submodules (sort (get-submodules #t) symbol<? #:key car))
(cond
[(parsed-module-compiled-module p)
=> (lambda (c)
@ -81,17 +81,17 @@
#:pre-submodules pre-submodules
#:post-submodules post-submodules
#:need-compiled-submodule-rename? need-compiled-submodule-rename?)]))
;; ------------------------------------------------------------
(define (compile-module-from-parsed p cctx
#:full-module-name full-module-name
#:force-linklet-directory? force-linklet-directory?
#:serializable? serializable?
#:to-correlated-linklet? to-correlated-linklet?
#:modules-being-compiled modules-being-compiled
#:pre-submodules pre-submodules
#:post-submodules post-submodules
#:pre-submodules pre-submodules ; sorted by name
#:post-submodules post-submodules ; sorted by name
#:need-compiled-submodule-rename? need-compiled-submodule-rename?)
(performance-region
['compile 'module]
@ -291,7 +291,7 @@
['compile 'module 'linklet]
(compile-linklet s 'data))))
(generate-module-data-linklet mpis))))
;; Combine linklets with other metadata as the bundle:
(define bundle
(let* ([bundle (hash-set body-linklets 'name full-module-name)]
@ -310,10 +310,10 @@
bundle)]
[bundle (if (null? pre-submodules)
bundle
(hash-set bundle 'pre (sort (map car pre-submodules) symbol<?)))]
(hash-set bundle 'pre (map car pre-submodules)))]
[bundle (if (null? post-submodules)
bundle
(hash-set bundle 'post (sort (map car post-submodules) symbol<?)))]
(hash-set bundle 'post (map car post-submodules)))]
[bundle (if cross-phase-persistent?
(hash-set bundle 'cross-phase-persistent? #t)
bundle)]

11
racket/src/racket/src/linklet.c
View File

@ -8,6 +8,7 @@ SHARED_OK Scheme_Hash_Tree *empty_hash_tree;
SHARED_OK static int validate_compile_result = 0;
SHARED_OK static int recompile_every_compile = 0;
SHARED_OK static int show_linklets = 0;
static Scheme_Object *serializable_symbol;
static Scheme_Object *unsafe_symbol;
@ -189,6 +190,9 @@ void scheme_init_linklet(Scheme_Startup_Env *env)
recompile_every_compile = 32;
}
}
if (scheme_getenv("PLT_LINKLET_SHOW"))
show_linklets = 1;
}
void scheme_init_unsafe_linklet(Scheme_Startup_Env *env)
@ -419,6 +423,13 @@ static Scheme_Object *compile_linklet(int argc, Scheme_Object **argv)
if (!SCHEME_STXP(e))
e = scheme_datum_to_syntax(e, scheme_false, DTS_CAN_GRAPH);
if (show_linklets) {
char *s;
intptr_t s_len;
s = scheme_write_to_string(scheme_syntax_to_datum(e), &s_len);
printf("%s\n", s);
}
if (argc > 4)
parse_compile_options("compile-linklet", 4, argc, argv, &unsafe, &static_mode);

241
racket/src/racket/src/startup.inc
View File

@ -39165,8 +39165,16 @@ static const char *startup_source =
" for-loop_0)"
" null"
"(hash-iterate-first ht_0)))))))))"
"(let-values(((pre-submodules_0)(get-submodules_0 #f)))"
"(let-values(((post-submodules_0)(get-submodules_0 #t)))"
"(let-values(((pre-submodules_0)"
"(let-values(((temp37_0)(get-submodules_0 #f))"
"((symbol<?38_0) symbol<?)"
"((car39_0) car))"
"(sort7.1 #f car39_0 temp37_0 symbol<?38_0))))"
"(let-values(((post-submodules_0)"
"(let-values(((temp40_0)(get-submodules_0 #t))"
"((symbol<?41_0) symbol<?)"
"((car42_0) car))"
"(sort7.1 #f car42_0 temp40_0 symbol<?41_0))))"
"(let-values(((c1_0)(parsed-module-compiled-module p_0)))"
"(if c1_0"
"((lambda(c_0)"
@ -39182,28 +39190,28 @@ static const char *startup_source =
"(map2 cdr post-submodules_0)))))"
" c1_0)"
"(let-values()"
"(let-values(((p37_0) p_0)"
"((cctx38_0) cctx_0)"
"((full-module-name39_0) full-module-name_0)"
"((force-linklet-directory?40_0) force-linklet-directory?_0)"
"((serializable?41_0) serializable?_0)"
"((to-correlated-linklet?42_0) to-correlated-linklet?_0)"
"((modules-being-compiled43_0) modules-being-compiled_0)"
"((pre-submodules44_0) pre-submodules_0)"
"((post-submodules45_0) post-submodules_0)"
"((need-compiled-submodule-rename?46_0)"
"(let-values(((p43_0) p_0)"
"((cctx44_0) cctx_0)"
"((full-module-name45_0) full-module-name_0)"
"((force-linklet-directory?46_0) force-linklet-directory?_0)"
"((serializable?47_0) serializable?_0)"
"((to-correlated-linklet?48_0) to-correlated-linklet?_0)"
"((modules-being-compiled49_0) modules-being-compiled_0)"
"((pre-submodules50_0) pre-submodules_0)"
"((post-submodules51_0) post-submodules_0)"
"((need-compiled-submodule-rename?52_0)"
" need-compiled-submodule-rename?_0))"
"(compile-module-from-parsed34.1"
" force-linklet-directory?40_0"
" full-module-name39_0"
" modules-being-compiled43_0"
" need-compiled-submodule-rename?46_0"
" post-submodules45_0"
" pre-submodules44_0"
" serializable?41_0"
" to-correlated-linklet?42_0"
" p37_0"
" cctx38_0)))))))))))))))))))))"
" force-linklet-directory?46_0"
" full-module-name45_0"
" modules-being-compiled49_0"
" need-compiled-submodule-rename?52_0"
" post-submodules51_0"
" pre-submodules50_0"
" serializable?47_0"
" to-correlated-linklet?48_0"
" p43_0"
" cctx44_0)))))))))))))))))))))"
"(define-values"
"(compile-module-from-parsed34.1)"
"(lambda(force-linklet-directory?17_0"
@ -39250,19 +39258,19 @@ static const char *startup_source =
"(let-values(((body-cctx_0)"
"(let-values(((the-struct_0) cctx_0))"
"(if(compile-context? the-struct_0)"
"(let-values(((phase47_0) 0)"
"((self48_0) self_0)"
"((module-self49_0) self_0)"
"((full-module-name50_0)"
"(let-values(((phase53_0) 0)"
"((self54_0) self_0)"
"((module-self55_0) self_0)"
"((full-module-name56_0)"
" full-module-name_0)"
"((lazy-syntax-literals?51_0) #t))"
"((lazy-syntax-literals?57_0) #t))"
"(compile-context1.1"
"(compile-context-namespace the-struct_0)"
" phase47_0"
" self48_0"
" module-self49_0"
" full-module-name50_0"
" lazy-syntax-literals?51_0"
" phase53_0"
" self54_0"
" module-self55_0"
" full-module-name56_0"
" lazy-syntax-literals?57_0"
"(compile-context-header the-struct_0)))"
"(raise-argument-error"
" 'struct-copy"
@ -39280,17 +39288,17 @@ static const char *startup_source =
"(if(hash-ref side-effects_0 phase_0 #f)"
"(void)"
"(let-values()"
"(if(let-values(((e52_0) e_0)"
"((expected-results53_0)"
"(if(let-values(((e58_0) e_0)"
"((expected-results59_0)"
" expected-results_0)"
"((required-reference?54_0)"
"((required-reference?60_0)"
" required-reference?_0))"
"(any-side-effects?9.1"
" unsafe-undefined"
" unsafe-undefined"
" required-reference?54_0"
" e52_0"
" expected-results53_0))"
" required-reference?60_0"
" e58_0"
" expected-results59_0))"
"(let-values()"
"(hash-set!"
" side-effects_0"
@ -39323,42 +39331,42 @@ static const char *startup_source =
" phase-to-link-extra-inspectorsss_0"
" syntax-literals_0"
" root-ctx-pos_0)"
"(let-values(((bodys55_0) bodys_0)"
"((body-cctx56_0) body-cctx_0)"
"((mpis57_0) mpis_0)"
"((temp58_0)"
"(let-values(((bodys61_0) bodys_0)"
"((body-cctx62_0) body-cctx_0)"
"((mpis63_0) mpis_0)"
"((temp64_0)"
"(list"
"(list"
" get-syntax-literal!-id)"
"(list"
" set-transformer!-id)))"
"((temp59_0)"
"((temp65_0)"
"(list"
" empty-syntax-literals-instance"
" empty-module-body-instance))"
"((temp60_0) '((void)))"
"((temp61_0) '(0))"
"((encoded-root-expand-ctx-box62_0)"
"((temp66_0) '((void)))"
"((temp67_0) '(0))"
"((encoded-root-expand-ctx-box68_0)"
" encoded-root-expand-ctx-box_0)"
"((body-context-simple?63_0)"
"((body-context-simple?69_0)"
" body-context-simple?_0)"
"((check-side-effects!64_0)"
"((check-side-effects!70_0)"
" check-side-effects!_0)"
"((temp65_0)"
"((temp71_0)"
"(lambda(body_0 cctx_1)"
"(if(parsed-#%declare?"
" body_0)"
"(let-values()"
"(let-values(((ok?_0"
" _70_0"
" kw71_0)"
" _76_0"
" kw77_0)"
"(let-values(((s_0)"
"(parsed-s"
" body_0)))"
"(let-values(((orig-s_0)"
" s_0))"
"(let-values(((_70_0"
" kw71_0)"
"(let-values(((_76_0"
" kw77_0)"
"(let-values(((s_1)"
"(if(syntax?$1"
" s_0)"
@ -39367,12 +39375,12 @@ static const char *startup_source =
" s_0)))"
"(if(pair?"
" s_1)"
"(let-values(((_72_0)"
"(let-values(((_78_0)"
"(let-values(((s_2)"
"(car"
" s_1)))"
" s_2))"
"((kw73_0)"
"((kw79_0)"
"(let-values(((s_2)"
"(cdr"
" s_1)))"
@ -39395,19 +39403,19 @@ static const char *startup_source =
"(let-values()"
" flat-s_0)))))))"
"(values"
" _72_0"
" kw73_0))"
" _78_0"
" kw79_0))"
"(raise-syntax-error$1"
" #f"
" \"bad syntax\""
" orig-s_0)))))"
"(values"
" #t"
" _70_0"
" kw71_0))))))"
" _76_0"
" kw77_0))))))"
"(begin"
"(let-values(((lst_0)"
" kw71_0))"
" kw77_0))"
"(begin"
"(if(variable-reference-from-unsafe?"
"(#%variable-reference))"
@ -39467,7 +39475,7 @@ static const char *startup_source =
"(void)"
" #f)))"
"(let-values() #f))))"
"((temp66_0)"
"((temp72_0)"
"(lambda(mod-name_0 phase_0)"
"(let-values(((ht_0)"
"(if modules-being-compiled_0"
@ -39482,29 +39490,29 @@ static const char *startup_source =
" phase_0"
" #f)"
" #f))))"
"((serializable?67_0)"
"((serializable?73_0)"
" serializable?_0)"
"((temp68_0) #t)"
"((to-correlated-linklet?69_0)"
"((temp74_0) #t)"
"((to-correlated-linklet?75_0)"
" to-correlated-linklet?_0))"
"(compile-forms33.1"
" temp59_0"
" temp58_0"
" temp60_0"
" check-side-effects!64_0"
" temp65_0"
" temp64_0"
" temp66_0"
" check-side-effects!70_0"
" #t"
" unsafe-undefined"
" encoded-root-expand-ctx-box62_0"
" temp61_0"
" temp66_0"
" temp68_0"
" temp65_0"
" body-context-simple?63_0"
" serializable?67_0"
" to-correlated-linklet?69_0"
" bodys55_0"
" body-cctx56_0"
" mpis57_0))))"
" encoded-root-expand-ctx-box68_0"
" temp67_0"
" temp72_0"
" temp74_0"
" temp71_0"
" body-context-simple?69_0"
" serializable?73_0"
" to-correlated-linklet?75_0"
" bodys61_0"
" body-cctx62_0"
" mpis63_0))))"
"(let-values((()"
"(begin"
"(if modules-being-compiled_0"
@ -39665,20 +39673,20 @@ static const char *startup_source =
" get-syntax-literal!-id"
" '(get-encoded-root-expand-ctx))"
"(qq-append"
"(let-values(((syntax-literals74_0)"
"(let-values(((syntax-literals80_0)"
" syntax-literals_0)"
"((mpis75_0)"
"((mpis81_0)"
" mpis_0)"
"((self76_0)"
"((self82_0)"
" self_0)"
"((temp77_0)"
"((temp83_0)"
"(not"
" serializable?_0)))"
"(generate-lazy-syntax-literals!9.1"
" temp77_0"
" syntax-literals74_0"
" mpis75_0"
" self76_0))"
" temp83_0"
" syntax-literals80_0"
" mpis81_0"
" self82_0))"
"(list"
"(list"
" 'define-values"
@ -39831,17 +39839,9 @@ static const char *startup_source =
"(hash-set"
" bundle_4"
" 'pre"
"(let-values(((temp78_0)"
"(map2"
" car"
" pre-submodules_0))"
"((symbol<?79_0)"
" symbol<?))"
"(sort7.1"
" #f"
" #f"
" temp78_0"
" symbol<?79_0))))))"
" pre-submodules_0)))))"
"(let-values(((bundle_6)"
"(if(null?"
" post-submodules_0)"
@ -39849,17 +39849,9 @@ static const char *startup_source =
"(hash-set"
" bundle_5"
" 'post"
"(let-values(((temp80_0)"
"(map2"
" car"
" post-submodules_0))"
"((symbol<?81_0)"
" symbol<?))"
"(sort7.1"
" #f"
" #f"
" temp80_0"
" symbol<?81_0))))))"
" post-submodules_0)))))"
"(let-values(((bundle_7)"
"(if cross-phase-persistent?_0"
"(hash-set"
@ -39896,16 +39888,16 @@ static const char *startup_source =
"(hash-set"
" bundle_10"
" 'side-effects"
"(let-values(((temp82_0)"
"(let-values(((temp84_0)"
"(hash-keys"
" side-effects_0))"
"((<83_0)"
"((<85_0)"
" <))"
"(sort7.1"
" #f"
" #f"
" temp82_0"
" <83_0)))"
" temp84_0"
" <85_0)))"
" bundle_10)))"
"(let-values(((bundle_12)"
"(if empty-result-for-module->namespace?_0"
@ -65305,14 +65297,29 @@ static const char *startup_source =
"(let-values(((or-part_0)(path-cache-get(cons s_1(get-reg_0)))))"
"(if or-part_0"
" or-part_0"
"(begin"
"(if log-performance?"
"(let-values()(start-performance-region 'eval 'resolve-symbol))"
"(void))"
"(begin0"
"(let-values()"
"(let-values(((cols_0 file_0)"
"(split-relative-string(symbol->string s_1) #f)))"
"(let-values(((f-file_0)"
"(if(null? cols_0)"
" \"main.rkt\""
" (string-append file_0 \".rkt\"))))"
"(let-values(((col_0)(if(null? cols_0) file_0(car cols_0))))"
"(let-values(((col-path_0)(if(null? cols_0) null(cdr cols_0))))"
" \"main.rkt\""
" (string-append file_0 \".rkt\"))))"
"(let-values(((col_0)"
"(if(null? cols_0) file_0(car cols_0))))"
"(let-values(((col-path_0)"
"(if(null? cols_0) null(cdr cols_0))))"
"(begin"
"(if log-performance?"
"(let-values()"
"(start-performance-region 'eval 'resolve-find))"
"(void))"
"(begin0"
"(let-values()"
"(find-col-file"
"(if(not subm-path_0)"
" show-collection-err_0"
@ -65324,7 +65331,13 @@ static const char *startup_source =
" col_0"
" col-path_0"
" f-file_0"
" #t))))))))"
" #t))"
"(if log-performance?"
"(let-values()(end-performance-region))"
"(void)))))))))"
"(if log-performance?"
"(let-values()(end-performance-region))"
"(void)))))))"
"(if(string? s_1)"
"(let-values()"
"(let-values(((dir_0)(get-dir_0)))"