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

fix cache comparison of scope-propagation tables

Browse Source 
Repairs 3eb2c20ad0, which used a scope-set comparison for
a table that maps scopes to propagation actions (add, remove,
or flip).

Closes #1113

Merge to v6.3
This commit is contained in:
Matthew Flatt 2015-10-30 20:30:42 -04:00
parent bfb245553c
commit d719c06e00
3 changed files with 34 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
pkgs/racket-test-core/tests/racket/module.rktl
View File

@ -1624,6 +1624,24 @@ case of module-leve bindings; it doesn't cover local bindings.
(test 1 values (lifted-require-of-x (submod 'has-a-submodule-that-exports-x b)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This test happens to trigger a combination
;; of lazy adds and reoves that exposed a bug
;; in caching lazy scope propagations
(eval
(expand
#'(module x racket/kernel
(module ma racket/base
(#%module-begin
(#%require (for-syntax racket/kernel))
(define-values (x) 1)
(define-syntaxes (foo) (lambda (stx) (quote-syntax x)))
(#%provide foo)))
(module mb racket/kernel
(#%require (submod ".." ma))
(foo)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

8
racket/src/racket/src/hash.c
View File

@ -2915,8 +2915,12 @@ static int hamt_equal_entries(int stype, void *eql_data,
Scheme_Object *k2, Scheme_Object *v2)
{
if (stype == scheme_eq_hash_tree_type) {
if (SAME_OBJ(k1, k2))
return scheme_recur_equal(v1, v2, eql_data);
if (SAME_OBJ(k1, k2)) {
if (eql_data)
return scheme_recur_equal(v1, v2, eql_data);
else
return SAME_OBJ(v1, v2);
}
} else if (stype == scheme_hash_tree_type) {
if (scheme_recur_equal(k1, k2, eql_data))
return scheme_recur_equal(v1, v2, eql_data);

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

@ -772,6 +772,13 @@ static int scopes_equal(Scheme_Scope_Set *a, Scheme_Scope_Set *b)
return (scope_set_count(a) == scope_set_count(b)) && scope_subset(a, b);
}
static int scope_props_equal(Scheme_Scope_Set *a, Scheme_Scope_Set *b)
{
return scheme_hash_tree_equal_rec((Scheme_Hash_Tree *)a, (Scheme_Object *)a,
(Scheme_Hash_Tree *)b, (Scheme_Object *)b,
NULL);
}
static Scheme_Object *make_fallback_pair(Scheme_Object *a, Scheme_Object *b)
{
a = scheme_make_vector(2, a);
@ -1809,8 +1816,10 @@ static void intern_scope_set(Scheme_Scope_Table *t, int prop_table)
if (recent_scope_sets[prop_table][i]) {
if (recent_scope_sets[prop_table][i] == t->simple_scopes)
return;
if (scopes_equal(recent_scope_sets[prop_table][i], t->simple_scopes)) {
if (scopes_equal(recent_scope_sets[prop_table][i], t->simple_scopes)
&& (!prop_table || scope_props_equal(recent_scope_sets[prop_table][i], t->simple_scopes))) {
t->simple_scopes = recent_scope_sets[prop_table][i];
return;
}
}
}