fix an inconsistency in free-identifier=?
Closes PR 13982
This commit is contained in:
parent
9a74e633ae
commit
ca002494e3
|
@ -970,6 +970,33 @@
|
||||||
|
|
||||||
(lam x x)))
|
(lam x x)))
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
;; Check consistency of `free-identifier=?' and binding
|
||||||
|
|
||||||
|
(module consistency-free-id-A racket
|
||||||
|
(provide g (rename-out [*a a]))
|
||||||
|
(define *a 10)
|
||||||
|
(define a 10)
|
||||||
|
(define-syntax g #'a))
|
||||||
|
|
||||||
|
(module consistency-free-id-B racket
|
||||||
|
(require 'consistency-free-id-A)
|
||||||
|
(provide consistency-free-id)
|
||||||
|
(define-syntax (n stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
[(_ ref)
|
||||||
|
(with-syntax ([in (syntax-local-introduce
|
||||||
|
(syntax-local-value #'g))])
|
||||||
|
#'(let ([in 10]) ; BINDING
|
||||||
|
(list (free-identifier=? #'in #'ref)
|
||||||
|
in
|
||||||
|
ref)))])) ; REFERENCE
|
||||||
|
(define (consistency-free-id) (n a)))
|
||||||
|
|
||||||
|
(require 'consistency-free-id-B)
|
||||||
|
|
||||||
|
(test (list #t 10 10) consistency-free-id)
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -4707,6 +4707,7 @@ int scheme_stx_module_eq3(Scheme_Object *a, Scheme_Object *b,
|
||||||
{
|
{
|
||||||
Scheme_Object *bsym;
|
Scheme_Object *bsym;
|
||||||
Scheme_Hash_Table *free_id_recur;
|
Scheme_Hash_Table *free_id_recur;
|
||||||
|
int must_be_lex;
|
||||||
|
|
||||||
if (!a || !b)
|
if (!a || !b)
|
||||||
return (a == b);
|
return (a == b);
|
||||||
|
@ -4730,9 +4731,18 @@ int scheme_stx_module_eq3(Scheme_Object *a, Scheme_Object *b,
|
||||||
asym = a;
|
asym = a;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
must_be_lex = 0;
|
||||||
|
|
||||||
/* Same name? */
|
/* Same name? */
|
||||||
if (!SAME_OBJ(asym, bsym))
|
if (!SAME_OBJ(asym, bsym)) {
|
||||||
return 0;
|
/* It's ok to have different names if they have
|
||||||
|
the same symbolic name and the same lexical binding,
|
||||||
|
so double-check that our shortcut worked... */
|
||||||
|
if (SAME_OBJ(SCHEME_STX_VAL(a), SCHEME_STX_VAL(b)))
|
||||||
|
must_be_lex = 1;
|
||||||
|
else
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
if ((a == asym) || (b == bsym))
|
if ((a == asym) || (b == bsym))
|
||||||
return 1;
|
return 1;
|
||||||
|
@ -4741,6 +4751,9 @@ int scheme_stx_module_eq3(Scheme_Object *a, Scheme_Object *b,
|
||||||
a = resolve_env(a, a_phase, 1, NULL, NULL, NULL, NULL, 0, free_id_recur);
|
a = resolve_env(a, a_phase, 1, NULL, NULL, NULL, NULL, 0, free_id_recur);
|
||||||
release_recur_table(free_id_recur);
|
release_recur_table(free_id_recur);
|
||||||
|
|
||||||
|
if (must_be_lex && !SCHEME_SYMBOLP(a))
|
||||||
|
return 0;
|
||||||
|
|
||||||
free_id_recur = make_recur_table();
|
free_id_recur = make_recur_table();
|
||||||
b = resolve_env(b, b_phase, 1, NULL, NULL, NULL, NULL, 0, free_id_recur);
|
b = resolve_env(b, b_phase, 1, NULL, NULL, NULL, NULL, 0, free_id_recur);
|
||||||
release_recur_table(free_id_recur);
|
release_recur_table(free_id_recur);
|
||||||
|
|
Loading…
Reference in New Issue
Block a user